The sequence is called ordered if it is non-decreasing or non-increasing. For example, sequnces [3, 1, 1, 0] and [1, 2, 3, 100] are ordered, but the sequence [1, 3, 3, 1] is not. You are given a sequence of numbers. You are to find it's shortest subsequence which is not ordered.A subsequence is a sequence that can be derived from the given sequence by deleting zero or more elements without changing the order of the remaining elements.

The first line of the input contains one integer n (1 ≤ n ≤ 105). The second line contains n space-separated integers — the given sequence. All numbers in this sequence do not exceed 106 by absolute value.

If the given sequence does not contain any unordered subsequences, output 0. Otherwise, output the length k of the shortest such subsequence. Then output k integers from the range [1..n] — indexes of the elements of this subsequence. If there are several solutions, output any of them.

import Data.Array
import List

getA = fmap (map read . words) getLine

main = do
	[n] <- getA
	x <- getA
	putStr $ let r = gao n x in unlines [show (length r), unwords (map show r)]

gao n x = if null e then [] else head e where
	a = listArray (1, n) x
	b = map head $ groupBy (\i j -> a!i == a!j) [1 .. n]
	c = length b
	d = listArray (1, c) b
	e = filter (\[i, j, k] -> (a!i < a!j) /= (a!j < a!k)) [[d!(i-1), d!i, d!(i+1)] | i <- [2 .. c - 1]]

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Text.Printf
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = do
  let readInt = fst . fromJust . BS.readInt
  n  <- readInt <$> BS.getLine
  xs  <- map readInt . BS.words <$> BS.getLine
  let diff = dropWhile ((== 0) . snd) . zip ([1 ..] :: [Int])
            $ zipWith (-) xs (tail xs)
      found idx1 (idx2, _) = printf "3\n%d %d %d\n" idx1 idx2 (idx2 + 1)
      notFound = print 0
  case diff of
    (idx1, d1) : _ | d1 < 0    -> maybe notFound (found idx1)
                                  $ find ((> 0) . snd) diff
                   | d1 > 0    -> maybe notFound (found idx1)
                                  $ find ((< 0) . snd) diff
    _                          -> notFound

import List
import Control.Arrow

bend :: [(Int, Int)] -> Maybe (Int, Int, Int)
bend ((ia, a):next@((ib, b):(ic, c):_)) =
  case (compare a b, compare b c) of
    (LT, GT) -> Just (ia, ib, ic)
    (GT, LT) -> Just (ia, ib, ic)
    _ -> bend next
bend _ = Nothing

solve xs =
  case bend (deduplicated xs) of
    Just (a, b, c) -> "3\n" ++ (concat $ intersperse " " (map show [a, b, c]))
    Nothing ->  "0\n"
  where
    deduplicated = map read . words . (!! 1) . lines >>>
                   tail . scanl (\ (i, _) n -> (i + 1, n)) (0, 0) >>>
                   map head . groupBy (\ (_, a) (_, b) -> a == b)

main = interact solve

import List
import Control.Arrow

bend :: [(Int, Int)] -> Maybe (Int, Int, Int)
bend ((ia, a):next@((ib, b):(ic, c):_)) =
  case (compare a b, compare b c) of
    (LT, GT) -> Just (ia, ib, ic)
    (GT, LT) -> Just (ia, ib, ic)
    _ -> bend next
bend _ = Nothing

solve xs =
  case bend (deduplicated xs) of
    Just (a, b, c) -> "3\n" ++ (concat $ intersperse " " (map show [a, b, c]))
    Nothing ->  "0\n"
  where
    deduplicated = map read . words . (!! 1) . lines >>>
                   zip [1..] >>>
                   map head . groupBy (\ (_, a) (_, b) -> a == b)

main = interact solve

import Data.List(groupBy, find)
import qualified Data.ByteString.Char8 as BS
import Data.Maybe(fromJust)
main = do
  getLine
  b <- fmap (map readInt . BS.words) BS.getLine
  let a :: [(Int,Int)]
      a = map head . groupBy (\x y -> snd x == snd y) . zip [1..] $ b
      n = length a
      triples = zip3 a (tail a) (tail $ tail a)
      good ((_,a),(_,b),(_,c)) = a>b && b<c || a<b && b>c
      ans = case find good triples of
        Nothing -> []
        Just ((a,_),(b,_),(c,_)) -> [a,b,c]
  if n < 3 || null ans
     then putStrLn "0"
     else do putStrLn "3"
             putStrLn . unwords . map show $ ans

readInt = fst . fromJust . BS.readInt

import Data.Array
import List

getA = fmap (map read . words) getLine

main = do
	[n] <- getA
	x <- getA
	putStr $ let r = gao n x in unlines [show (length r), unwords (map show r)]

gao n x = if null e then [] else head e where
	a = listArray (1, n) x
	b = map head $ groupBy (\i j -> a!i == a!j) [1 .. n]
	c = length b
	d = listArray (1, c) b
	e = filter (\[i, j, k] -> (a!i < a!j) /= (a!j < a!k)) [[d!i-1, d!i, d!i+1] | i <- [2 .. c - 1]]

import List

bend :: Int -> [Int] -> Maybe (Int, Int, Int)
bend i (a:next@(b:c:_)) =
  case (compare a b, compare b c) of
    (LT, GT) -> Just (i, i + 1, i + 2)
    (GT, LT) -> Just (i, i + 1, i + 2)
    _ -> bend (i + 1) next
bend _ _ = Nothing

solve xs =
  case (bend 1) $ (map read) $ words $ (!! 1) $ lines $ xs of
    Just (a, b, c) -> "3\n" ++ (concat $ intersperse " " (map show [a, b, c]))
    Nothing ->  "0\n"

main = interact solve

import List
import Control.Arrow

bend :: [(Int, Int)] -> Maybe (Int, Int, Int)
bend ((ia, a):next@((ib, b):(ic, c):_)) =
  case (compare a b, compare b c) of
    (LT, GT) -> Just (ia, ib, ic)
    (GT, LT) -> Just (ia, ib, ic)
    _ -> bend next
bend _ = Nothing

solve xs =
  case bend (deduplicated xs) of
    Just (a, b, c) -> "3\n" ++ (concat $ intersperse " " (map show [a, b, c]))
    Nothing ->  "0\n"
  where
    deduplicated = map read . words . (!! 1) . lines >>>
                   (\xs -> [ (ia, a) | ia <- [1..], a <- xs ]) >>>
                   map head . groupBy (\ (_, a) (_, b) -> a == b)

main = interact solve


Berland scientists face a very important task - given the parts of short DNA fragments, restore the dinosaur DNA! The genome of a berland dinosaur has noting in common with the genome that we've used to: it can have 26 distinct nucleotide types, a nucleotide of each type can occur at most once. If we assign distinct English letters to all nucleotides, then the genome of a Berland dinosaur will represent a non-empty string consisting of small English letters, such that each letter occurs in it at most once.Scientists have n genome fragments that are represented as substrings (non-empty sequences of consecutive nucleotides) of the sought genome.You face the following problem: help scientists restore the dinosaur genome. It is guaranteed that the input is not contradictory and at least one suitable line always exists. When the scientists found out that you are a strong programmer, they asked you in addition to choose the one with the minimum length. If there are multiple such strings, choose any string.

The first line of the input contains a positive integer n (1 ≤ n ≤ 100) — the number of genome fragments. Each of the next lines contains one descriptions of a fragment. Each fragment is a non-empty string consisting of distinct small letters of the English alphabet. It is not guaranteed that the given fragments are distinct. Fragments could arbitrarily overlap and one fragment could be a substring of another one. It is guaranteed that there is such string of distinct letters that contains all the given fragments as substrings.

In the single line of the output print the genome of the minimum length that contains all the given parts. All the nucleotides in the genome must be distinct. If there are multiple suitable strings, print the string of the minimum length. If there also are multiple suitable strings, you can print any of them.

import           Control.Monad
import qualified Data.Map.Strict as Map
import qualified Data.Set        as Set

main :: IO ()
main = do
  n <- fmap read getLine
  strs <- replicateM n getLine
  let seconds = Set.fromList $ concatMap tail strs
      firsts = Set.toList $ Set.difference (Set.fromList $ map head strs) seconds
      conts  = Map.fromList $ concatMap (\xs -> zip xs $ tail xs) strs
      start [] _ = []
      start (f:fs) cs = continue f fs cs
      continue cur fs cs = cur: case Map.lookup cur cs of
        Just next -> continue next fs cs
        Nothing -> start fs cs
  putStrLn $ start firsts conts

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Prelude hiding (lookup)
import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Map (fromList, elems, lookup)
import Data.Set (difference)
import qualified Data.Set as S

solve :: [String] -> String
solve xs = S.foldr go "" root
    where
    next = fromList . concat . zipWith zip xs $ map tail xs
    -- all the observed values which are not preceded by any letter
    root = S.fromList (concat xs) `difference` S.fromList (elems next)

    go i acc = case i `lookup` next of
        Just j  -> i: go j acc
        Nothing -> i: acc

main = do
    n <- read <$> getLine
    a <- replicateM n getLine
    putStrLn $ solve a

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

main :: IO ()
main = do
  n <- fmap read getLine
  strs <- replicateM n getLine
  let prereq =  Map.unionsWith Set.union $ map req strs
      req = Map.fromList . snd . mapAccumL prev Set.empty
      prev prevs x = (Set.insert x prevs, (x, prevs))
      go prer | Map.null prer = []
              | otherwise     =
        let (first, _) = Map.findMin $ Map.filter Set.null prer
            prer'      = Map.map (Set.delete first) $  Map.delete first prer
            in first : go prer'
  putStrLn $ go prereq


You have $$$n$$$ gifts and you want to give all of them to children. Of course, you don't want to offend anyone, so all gifts should be equal between each other. The $$$i$$$-th gift consists of $$$a_i$$$ candies and $$$b_i$$$ oranges.During one move, you can choose some gift $$$1 \le i \le n$$$ and do one of the following operations:  eat exactly one candy from this gift (decrease $$$a_i$$$ by one);  eat exactly one orange from this gift (decrease $$$b_i$$$ by one);  eat exactly one candy and exactly one orange from this gift (decrease both $$$a_i$$$ and $$$b_i$$$ by one). Of course, you can not eat a candy or orange if it's not present in the gift (so neither $$$a_i$$$ nor $$$b_i$$$ can become less than zero).As said above, all gifts should be equal. This means that after some sequence of moves the following two conditions should be satisfied: $$$a_1 = a_2 = \dots = a_n$$$ and $$$b_1 = b_2 = \dots = b_n$$$ (and $$$a_i$$$ equals $$$b_i$$$ is not necessary).Your task is to find the minimum number of moves required to equalize all the given gifts.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 50$$$) — the number of gifts. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is the number of candies in the $$$i$$$-th gift. The third line of the test case contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$1 \le b_i \le 10^9$$$), where $$$b_i$$$ is the number of oranges in the $$$i$$$-th gift.

For each test case, print one integer: the minimum number of moves required to equalize all the given gifts.

NoteIn the first test case of the example, we can perform the following sequence of moves:  choose the first gift and eat one orange from it, so $$$a = [3, 5, 6]$$$ and $$$b = [2, 2, 3]$$$;  choose the second gift and eat one candy from it, so $$$a = [3, 4, 6]$$$ and $$$b = [2, 2, 3]$$$;  choose the second gift and eat one candy from it, so $$$a = [3, 3, 6]$$$ and $$$b = [2, 2, 3]$$$;  choose the third gift and eat one candy and one orange from it, so $$$a = [3, 3, 5]$$$ and $$$b = [2, 2, 2]$$$;  choose the third gift and eat one candy from it, so $$$a = [3, 3, 4]$$$ and $$$b = [2, 2, 2]$$$;  choose the third gift and eat one candy from it, so $$$a = [3, 3, 3]$$$ and $$$b = [2, 2, 2]$$$.

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))

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

process :: [[Integer]] -> [Integer]
process [] = []
process ([_] : xs : ys : rest) = solve xs ys : process rest

solve :: [Integer] -> [Integer] -> Integer
solve xs ys = sum $ zipWith max (reduce xs) (reduce ys)
  where
    reduce xs = subtract (minimum xs) <$> xs

{-# LANGUAGE Safe #-}

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

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

process :: [[Integer]] -> [Integer]
process [] = []
process ([_] : xs : ys : rest) = solve xs ys : process rest

solve :: [Integer] -> [Integer] -> Integer
solve xs ys =
  sum $
    zipWith
      max
      (zipWith (-) xs (repeat (minimum xs)))
      (zipWith (-) ys (repeat (minimum ys)))

solve :: [Integer] -> [Integer] -> Integer
solve as bs = sum  $ zipWith solve' as bs
  where
    minA = minimum as
    minB = minimum bs
    solve' a b = max (a - minA) (b - minB)

clean :: [String] -> [(String, String)]
clean []           = []
clean (_ : a : b: ss) = (a,b) : clean ss
clean _            = undefined

mapPair :: (a -> b) -> (a, a) -> (b, b)
mapPair f (a, b) = (f a, f b)

main :: IO ()
main = interact
  (unlines . map (show . uncurry solve . mapPair (map read . words) ) . clean . tail . lines)

import Control.Monad
import Data.List

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- getLine
    as <- map read . words <$> getLine
    bs <- map read . words <$> getLine
    let
      minA = foldl' min (head as) (tail as)
      minB = foldl' min (head bs) (tail bs)
      cost = sum $ zipWith act as bs where
        act a b = max (a - minA) (b - minB)
    putStrLn $ show cost

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.Bool
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  as <- map read . words <$> getLine
  bs <- map read . words <$> getLine
  let moves = zip (subtract (minimum as) <$> as) (subtract (minimum bs) <$> bs)
  print $ sum $ (\(a, b) -> a + b - min a b) <$> moves

#!/usr/bin/env stack
-- stack --resolver nightly-2020-08-16 script

import Data.List
import Control.Monad

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

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

readLineInts :: String -> [Int]
readLineInts s = map readInt $ words s

getInts :: IO [Int]
getInts = readLineInts <$> getLine

main :: IO ()
main = do
    testCount <- getInt
    replicateM_ testCount test

test :: IO ()
test = do
    getInt
    as <- map read . words <$> getLine
    bs <- map read . words <$> getLine
    let minA = minimum as
    let minB = minimum bs
    let actCount = sum $ map (pToAct minA minB) $ zip as bs
    print actCount

pToAct :: (Ord a, Num a) => a -> a -> (a, a) -> a
pToAct minA minB (a, b) = max (a - minA) (b - minB)

#!/usr/bin/env stack
-- stack --resolver nightly-2020-08-16 script

import Control.Monad

solve :: IO ()
solve = do
  getLine
  as <- map read . words <$> getLine
  bs <- map read . words <$> getLine
  let moves = zip (subtract (minimum as) <$> as) (subtract (minimum bs) <$> bs)
  print $ sum $ (\(a, b) -> a + b - min a b) <$> moves

main :: IO ()
main = do
  getLine >>= flip replicateM_ solve . read

convert :: Read a => String -> [a]
convert = map read . words

solve :: Int -> IO ()
solve 0 = putStrLn ""
solve t = do
  line <- getLine
  line <- getLine
  let a = convert line :: [Integer]
  let la = foldl min (head a) a
  line <- getLine
  let b = convert line :: [Integer]
  let lb = foldl min (head b) b
  let c = map (\(x, y) -> max (x - la) (y - lb)) (zip a b)
  print $ sum c
  solve $ t - 1

main :: IO ()
main = do
  line <- getLine
  let [t] = convert line :: [Int]
  solve t

import Control.Monad
import Data.Int

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    getLine
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    print (solve a b)

solve :: [Int64] -> [Int64] -> Int64
solve a b = sum $ zipWith (\x y -> max (x - a_min) (y - b_min)) a b
  where
    a_min = minimum a
    b_min = minimum b

module Main where

    solve :: IO ()
    solve = do
        _ <- getLine
        sa <- getLine
        sb <- getLine
        let a = map (\x -> read x :: Integer) $ words sa
            b = map (\x -> read x :: Integer) $ words sb
            ma = minimum a
            mb = minimum b
            n = length a
        print $ sum [max (a !! i - ma) (b !! i - mb) | i <- [0..n - 1]]

    iter :: Integer -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        s <- getLine
        iter (read s :: Integer)

import Control.Monad -- for replicateM_

solve :: [Integer] -> [Integer] -> Integer
solve a b = answer
    where
        min_a = minimum a
        min_b = minimum b
        substract_min_a = map (\x -> x - min_a) a
        substract_min_b = map (\x -> x - min_b) b
        answer = sum $ zipWith (\x y -> max x y) substract_min_a substract_min_b

deal :: IO()
deal = do
    getLine
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    putStrLn $ show $ solve a b

main :: IO()
main = getLine >>= flip replicateM_ deal . read

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

process n [] [] _ _ = n
process n (x:xs) (y:ys) mx my = process (n+(max (x-mx) (y-my) )) xs ys mx my

onecase = do
		getLine
		x<- map read <$> words <$> getLine ::IO [Integer]
		y<- map read <$> words <$> getLine ::IO [Integer]
		print $ process 0 x y (minimum x) (minimum y)

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

solve :: [Int] -> [Int] -> Int
solve as bs = sum  $ zipWith solve' as bs
  where
    minA = minimum as
    minB = minimum bs
    solve' a b = max (a - minA) (b - minB)

clean :: [String] -> [(String, String)]
clean []           = []
clean (_ : a : b: ss) = (a,b) : clean ss
clean _            = undefined

mapPair :: (a -> b) -> (a, a) -> (b, b)
mapPair f (a, b) = (f a, f b)

main :: IO ()
main = interact
  (unlines . map (show . uncurry solve . mapPair (map read . words) ) . clean . tail . lines)

#!/usr/bin/env stack
-- stack --resolver nightly-2020-08-16 script

import Data.List
import Control.Monad

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

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

readLineInts :: String -> [Int]
readLineInts s = map readInt $ words s

getInts :: IO [Int]
getInts = readLineInts <$> getLine

main :: IO ()
main = do
    testCount <- getInt
    replicateM_ testCount test

test :: IO ()
test = do
    n <- getInt
    as <- getInts
    bs <- getInts
    let minA = minimum as
    let minB = minimum bs
    let actCount = sum $ map (pToAct minA minB) $ zip as bs
    print actCount

pToAct :: (Ord a, Num a) => a -> a -> (a, a) -> a
pToAct minA minB (a, b) = max (a - minA) (b - minB)

#!/usr/bin/env stack
-- stack --resolver lts-16.10 script

import Data.List
import Control.Monad

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

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

readLineInts :: String -> [Int]
readLineInts s = map readInt $ words s

getInts :: IO [Int]
getInts = readLineInts <$> getLine

main :: IO ()
main = do
    testCount <- getInt
    replicateM_ testCount test

test :: IO ()
test = do
    n <- getInt
    as <- getInts
    bs <- getInts
    let minA = minimum as
    let minB = minimum bs
    let actCount = sum $ map (pToAct minA minB) $ zip as bs
    print actCount

pToAct :: (Ord a, Num a) => a -> a -> (a, a) -> a
pToAct minA minB (a, b) = max (a - minA) (b - minB)


Each item in the game has a level. The higher the level is, the higher basic parameters the item has. We shall consider only the following basic parameters: attack (atk), defense (def) and resistance to different types of impact (res).Each item belongs to one class. In this problem we will only consider three of such classes: weapon, armor, orb.Besides, there's a whole new world hidden inside each item. We can increase an item's level travelling to its world. We can also capture the so-called residents in the Item WorldResidents are the creatures that live inside items. Each resident gives some bonus to the item in which it is currently located. We will only consider residents of types: gladiator (who improves the item's atk), sentry (who improves def) and physician (who improves res).Each item has the size parameter. The parameter limits the maximum number of residents that can live inside an item. We can move residents between items. Within one moment of time we can take some resident from an item and move it to some other item if it has a free place for a new resident. We cannot remove a resident from the items and leave outside — any of them should be inside of some item at any moment of time.Laharl has a certain number of items. He wants to move the residents between items so as to equip himself with weapon, armor and a defensive orb. The weapon's atk should be largest possible in the end. Among all equipping patterns containing weapon's maximum atk parameter we should choose the ones where the armor’s def parameter is the largest possible. Among all such equipment patterns we should choose the one where the defensive orb would have the largest possible res parameter. Values of the parameters def and res of weapon, atk and res of armor and atk and def of orb are indifferent for Laharl.Find the optimal equipment pattern Laharl can get.

The first line contains number n (3 ≤ n ≤ 100) — representing how many items Laharl has. Then follow n lines. Each line contains description of an item. The description has the following form: "name class atk def res size" — the item's name, class, basic attack, defense and resistance parameters and its size correspondingly.    name and class are strings and atk, def, res and size are integers.  name consists of lowercase Latin letters and its length can range from 1 to 10, inclusive.  class can be "weapon", "armor" or "orb".  0 ≤ atk, def, res ≤ 1000.  1 ≤ size ≤ 10.  It is guaranteed that Laharl has at least one item of each class. The next line contains an integer k (1 ≤ k ≤ 1000) — the number of residents. Then k lines follow. Each of them describes a resident. A resident description looks like: "name type bonus home" — the resident's name, his type, the number of points the resident adds to the item's corresponding parameter and the name of the item which currently contains the resident.    name, type and home are strings and bonus is an integer.  name consists of lowercase Latin letters and its length can range from 1 to 10, inclusive.  type may be "gladiator", "sentry" or "physician".  1 ≤ bonus ≤ 100.  It is guaranteed that the number of residents in each item does not exceed the item's size. The names of all items and residents are pairwise different. All words and numbers in the input are separated by single spaces.

Print on the first line the name of the weapon in the optimal equipping pattern; then print the number of residents the weapon contains; then print the residents' names. Print on the second and third lines in the same form the names of the armor and defensive orb as well as the residents they contain.  Use single spaces for separation. If there are several possible solutions, print any of them.

4
sword weapon 10 2 3 2
pagstarmor armor 0 15 3 1
iceorb orb 3 2 13 2
longbow weapon 9 1 2 1
5
mike gladiator 5 longbow
bobby sentry 6 pagstarmor
petr gladiator 7 iceorb
teddy physician 6 sword
blackjack sentry 8 sword

4
sword weapon 10 2 3 2
pagstarmor armor 0 15 3 1
iceorb orb 3 2 13 2
longbow weapon 9 1 2 1
6
mike gladiator 5 longbow
bobby sentry 6 pagstarmor
petr gladiator 7 iceorb
teddy physician 6 sword
blackjack sentry 8 sword
joe physician 6 iceorb

sword 2 petr mike
pagstarmor 1 blackjack
iceorb 2 teddy bobby

longbow 1 mike
pagstarmor 1 bobby
iceorb 2 petr joe

NoteIn the second sample we have no free space inside the items, therefore we cannot move the residents between them.

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Ord
import Control.Applicative
import Control.Monad
import qualified Data.Map as Map
import Data.Map(Map)
import Data.List
import Control.Arrow
import Data.Maybe

data ItemType = Weapon | Armor | Orb deriving (Eq)

type ItemName = String

data Item = Item {
  itemName :: ItemName,
  itemType :: ItemType,
  itemStat :: Integer,
  itemSize :: Integer
  }

type Resident = (String, ItemType, Integer, ItemName)

parseItemType "weapon" = Weapon
parseItemType "armor" = Armor
parseItemType "orb" = Orb

parseStat Weapon a d r = read a
parseStat Armor a d r = read d
parseStat Orb a d r = read r

parseItem [n, t, a, d, r, s] = Item n (parseItemType t) (parseStat (parseItemType t) a d r) (read s)

parseResidentType "gladiator" = Weapon
parseResidentType "sentry" = Armor
parseResidentType "physician" = Orb

parseResident :: [String] -> Resident
parseResident [n, t, s, i] = (n, parseResidentType t, read s, i)

helps t (_, t', _, _) = t == t'

residentStr (_, _, s, _) = s

residentItem (_, _, _, i) = i

select2 :: ItemType -> ([Item], [Resident]) -> (Item, [Resident])
select2 t (items, residents) = (bestItem, itemResidents bestItem)
  where
    itemResidents item = filter ((== itemName item) . residentItem) residents
    bestItem = maximumBy (comparing itemStrength) (filter ((==t) . itemType) items)
    itemStrength i = itemStat i + sum (map residentStr $ filter (helps t) $ itemResidents i)

select :: ItemType -> ([Item], [Resident]) -> (Item, [Resident])
select t (items, residents) = (bestItem, genericTake (itemSize bestItem) rs)
  where
      (i', r') = (filter ((==t) . itemType) items, filter (helps t) residents)
      rs = reverse $ sortBy (comparing residentStr) r'
      bestItem = maximumBy (comparing $ \i -> itemStat i + sum (map residentStr $ genericTake (itemSize i) rs)) i'

residentName (n, _, _, _) = n

printItem i rs = putStrLn (unwords $ [itemName i, show $ length rs] ++ map residentName rs)

main = do
  n <- read <$> getLine
  items <- sequence $ genericReplicate n $ parseItem . words <$> getLine
  m <- read <$> getLine
  residents <- sequence $ genericReplicate m $ parseResident . words <$> getLine
  let allFull = sum (map itemSize items) == genericLength residents
  if not allFull
    then do
      let (w, wr) = select Weapon (items, residents)
      let (a, ar) = select Armor (items, residents)
      let (o, or) = select Orb (items, residents)
          toFit = filter (\r -> r `notElem` (wr ++ ar ++ or)) residents
          (wrP, toFit') = genericSplitAt (itemSize w - genericLength wr) toFit
          (arP, toFit'') = genericSplitAt (itemSize a - genericLength ar) toFit'
          (orP, _) = genericSplitAt (itemSize o - genericLength or) toFit''
      printItem w (wr ++ wrP)
      printItem a (ar ++ arP)
      printItem o (or ++ orP)
    else do
      uncurry printItem (select2 Weapon (items, residents))
      uncurry printItem (select2 Armor (items, residents))
      uncurry printItem (select2 Orb (items, residents))


You are given a text consisting of n lines. Each line contains some space-separated words, consisting of lowercase English letters.We define a syllable as a string that contains exactly one vowel and any arbitrary number (possibly none) of consonants. In English alphabet following letters are considered to be vowels: 'a', 'e', 'i', 'o', 'u' and 'y'.Each word of the text that contains at least one vowel can be divided into syllables. Each character should be a part of exactly one syllable. For example, the word "mamma" can be divided into syllables as "ma" and "mma", "mam" and "ma", and "mamm" and "a". Words that consist of only consonants should be ignored.The verse patterns for the given text is a sequence of n integers p1, p2, ..., pn. Text matches the given verse pattern if for each i from 1 to n one can divide words of the i-th line in syllables in such a way that the total number of syllables is equal to pi.You are given the text and the verse pattern. Check, if the given text matches the given verse pattern.

The first line of the input contains a single integer n (1 ≤ n ≤ 100) — the number of lines in the text. The second line contains integers p1, ..., pn (0 ≤ pi ≤ 100) — the verse pattern. Next n lines contain the text itself. Text consists of lowercase English letters and spaces. It's guaranteed that all lines are non-empty, each line starts and ends with a letter and words are separated by exactly one space. The length of each line doesn't exceed 100 characters.

If the given text matches the given verse pattern, then print "YES" (without quotes) in the only line of the output. Otherwise, print "NO" (without quotes).

4
13 11 15 15
to be or not to be that is the question
whether tis nobler in the mind to suffer
the slings and arrows of outrageous fortune
or to take arms against a sea of troubles

NoteIn the first sample, one can split words into syllables in the following way: in-telco-dech al-len-geSince the word "ch" in the third line doesn't contain vowels, we can ignore it. As the result we get 2 syllabels in first two lines and 3 syllables in the third one.

import Control.Monad

getInt = read `fmap` getLine :: IO Int

containsVowel str = any (`elem` "aeiouy") str
countVowel str = length (filter (`elem` "aeiouy") str)

main = do
    n <- getInt
    patterns <- (map read . words) `fmap` getLine :: IO [Int]
    lines <- replicateM n getLine
    results <- forM (zip patterns lines) $ \(pat, line) -> do
        let cands = filter containsVowel (words line)
        if pat == sum (map countVowel cands)
        then return True
        else return False
    if all id results
    then putStrLn "YES"
    else putStrLn "NO"

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	getLine
	ps <- readInts
	ss <- lines <$> getContents
	putStrLn $ which "YES" "NO" $ ps == map f ss

f s = length $ filter ( `elem` "aeiouy" ) $ s

main = interact $ parse . tail . lines

parse (x:xs)
  | i == k = "YES"
  | otherwise = "NO"
  where i = (map read (words x)) :: [Int]
        j = map f xs
        k = map (length) j

f = filter (\a -> a == 'a'
                  || a=='e'
                  || a=='i'
                  || a=='o'
                  || a=='u'
                  || a=='y')

import           Control.Applicative
import           Control.Monad
import           Data.Bool

main :: IO ()
main = do
  n <- readLn
  xs <- map read.words <$> getLine
  css <- replicateM n getLine
  putStrLn . bool "NO" "YES" .and $ zipWith (==) xs [length$filter(`elem`"aeiouy")cs|cs<-css]

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

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	getLine
	ps <- readInts
	ss <- lines <$> getContents
	putStrLn $ which "YES" "NO" $ and $ zipWith f ps ss

f p s
	| vowels == 0 = True
	| otherwise = vowels == p
	where
		vowels = length $ filter ( `elem` "aeiouy" ) $ s


Toad Ivan has $$$m$$$ pairs of integers, each integer is between $$$1$$$ and $$$n$$$, inclusive. The pairs are $$$(a_1, b_1), (a_2, b_2), \ldots, (a_m, b_m)$$$. He asks you to check if there exist two integers $$$x$$$ and $$$y$$$ ($$$1 \leq x < y \leq n$$$) such that in each given pair at least one integer is equal to $$$x$$$ or $$$y$$$.

The first line contains two space-separated integers $$$n$$$ and $$$m$$$ ($$$2 \leq n \leq 300\,000$$$, $$$1 \leq m \leq 300\,000$$$) — the upper bound on the values of integers in the pairs, and the number of given pairs. The next $$$m$$$ lines contain two integers each, the $$$i$$$-th of them contains two space-separated integers $$$a_i$$$ and $$$b_i$$$ ($$$1 \leq a_i, b_i \leq n, a_i \neq b_i$$$) — the integers in the $$$i$$$-th pair.

Output "YES" if there exist two integers $$$x$$$ and $$$y$$$ ($$$1 \leq x < y \leq n$$$) such that in each given pair at least one integer is equal to $$$x$$$ or $$$y$$$. Otherwise, print "NO". You can print each letter in any case (upper or lower).

NoteIn the first example, you can't choose any $$$x$$$, $$$y$$$ because for each such pair you can find a given pair where both numbers are different from chosen integers.In the second example, you can choose $$$x=2$$$ and $$$y=4$$$.In the third example, you can choose $$$x=1$$$ and $$$y=2$$$.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

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

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	[ n, m ] <- readInts
	ps <- map mp <$> replicateM m readInts
	putStrLn $ which "YES" "NO" $ solve ps ( fst $ head ps ) (-1) || solve ps ( snd $ head ps ) (-1)

solve [] _ _ = True
solve ( ( a, b ) : ps ) x y
	| a == x || b == x = solve ps x y
	| y == -1 = solve ps x a || solve ps x b
	| a == y || b == y = solve ps x y
	| otherwise = False

import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B
import Control.Applicative (liftA2)

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

sg = group . sort
lh = liftA2 (,) head length
count = map lh . sg
yesno b = if b then "YES" else "NO"

solve :: ([Int] -> Int) -> [[Int]] -> Bool
solve g v = length missing == 0
            || (maximum . map snd . count . concat) missing == length missing
    where val     = g $ head v
          missing = filter (not . elem val) v

main :: IO ()
main = do
    [n, m] <- readInts
    v <- replicateM m readInts
    putStrLn $ yesno $ (solve head v || solve last v)


Let $$$s(x)$$$ be sum of digits in decimal representation of positive integer $$$x$$$. Given two integers $$$n$$$ and $$$m$$$, find some positive integers $$$a$$$ and $$$b$$$ such that   $$$s(a) \ge n$$$,  $$$s(b) \ge n$$$,  $$$s(a + b) \le m$$$.

The only line of input contain two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 1129$$$).

Print two lines, one for decimal representation of $$$a$$$ and one for decimal representation of $$$b$$$. Both numbers must not contain leading zeros and must have length no more than $$$2230$$$.

NoteIn the first sample, we have $$$n = 6$$$ and $$$m = 5$$$. One valid solution is $$$a = 6$$$, $$$b = 7$$$. Indeed, we have $$$s(a) = 6 \ge n$$$ and $$$s(b) = 7 \ge n$$$, and also $$$s(a + b) = s(13) = 4 \le m$$$.

--import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.List
import Data.Maybe

main = do
  let a = (10^2000 - 1) `div` 9
      b = 10^2000 - a
  print a
  print b

-- Below is template code
readInt = fst . fromJust . B.readInt
lineInt = readInt <$> B.getLine
lineInts = map readInt . B.words <$> B.getLine

--infixr 0 ##
--(##) x msg = traceShow msg x

main = putStrLn . unwords $ [replicate 2230 '5', replicate 2229 '4' ++ "5"]

import Control.Monad
import Data.Bool
import Data.Tuple
import Data.Maybe
import Data.Tree
import Data.Graph
import Data.Array.IArray
import Data.List
import Data.List.Split
import qualified Data.ByteString.Char8 as B

iogetints :: IO [Int]
iogetints = getLine >>= (return . map read . words)

freadEdgeList :: IO [Edge]
freadEdgeList = B.getContents >>= (return . pairify . map (fst . fromJust . B.readInt) . B.words)

indexed :: [a] -> [(Int, a)]
indexed = go 0 where
 go :: Int -> [a] -> [(Int, a)]
 go _ [] = []
 go i (x:xs) = (i, x) : (go (succ i) xs)

foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree f = go where
 go (Node x ts) = f x (map go ts)

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

buildTree :: Int -> Vertex -> [Edge] -> Tree Vertex
buildTree n r es = fdfs (-1) r where
 g = accumArray (flip (:)) [] (1, n) $ ap (++) (map swap) $ es :: Graph
 fdfs :: Vertex -> Vertex -> Tree Vertex
 fdfs p v = Node v $ map (fdfs v) $ delete p $ g!v

both :: (a -> b) -> (a, a) -> (b, b)
both f (x, y) = (f x, f y)

solve :: String
solve = (replicate 2000 '8') ++ "9" ++ "\n" ++ (replicate 2001 '1')

main :: IO ()
main = do
  putStrLn $ solve


You are given two binary strings $$$x$$$ and $$$y$$$, which are binary representations of some two integers (let's denote these integers as $$$f(x)$$$ and $$$f(y)$$$). You can choose any integer $$$k \ge 0$$$, calculate the expression $$$s_k = f(x) + f(y) \cdot 2^k$$$ and write the binary representation of $$$s_k$$$ in reverse order (let's denote it as $$$rev_k$$$). For example, let $$$x = 1010$$$ and $$$y = 11$$$; you've chosen $$$k = 1$$$ and, since $$$2^1 = 10_2$$$, so $$$s_k = 1010_2 + 11_2 \cdot 10_2 = 10000_2$$$ and $$$rev_k = 00001$$$.For given $$$x$$$ and $$$y$$$, you need to choose such $$$k$$$ that $$$rev_k$$$ is lexicographically minimal (read notes if you don't know what does "lexicographically" means).It's guaranteed that, with given constraints, $$$k$$$ exists and is finite.

The first line contains a single integer $$$T$$$ ($$$1 \le T \le 100$$$) — the number of queries. Next $$$2T$$$ lines contain a description of queries: two lines per query. The first line contains one binary string $$$x$$$, consisting of no more than $$$10^5$$$ characters. Each character is either 0 or 1. The second line contains one binary string $$$y$$$, consisting of no more than $$$10^5$$$ characters. Each character is either 0 or 1. It's guaranteed, that $$$1 \le f(y) \le f(x)$$$ (where $$$f(x)$$$ is the integer represented by $$$x$$$, and $$$f(y)$$$ is the integer represented by $$$y$$$), both representations don't have any leading zeroes, the total length of $$$x$$$ over all queries doesn't exceed $$$10^5$$$, and the total length of $$$y$$$ over all queries doesn't exceed $$$10^5$$$.

Print $$$T$$$ integers (one per query). For each query print such $$$k$$$ that $$$rev_k$$$ is lexicographically minimal.

NoteThe first query was described in the legend.In the second query, it's optimal to choose $$$k = 3$$$. The $$$2^3 = 1000_2$$$ so $$$s_3 = 10001_2 + 110_2 \cdot 1000_2 = 10001 + 110000 = 1000001$$$ and $$$rev_3 = 1000001$$$. For example, if $$$k = 0$$$, then $$$s_0 = 10111$$$ and $$$rev_0 = 11101$$$, but $$$rev_3 = 1000001$$$ is lexicographically smaller than $$$rev_0 = 11101$$$.In the third query $$$s_0 = 10$$$ and $$$rev_0 = 01$$$. For example, $$$s_2 = 101$$$ and $$$rev_2 = 101$$$. And $$$01$$$ is lexicographically smaller than $$$101$$$.The quote from Wikipedia: "To determine which of two strings of characters comes when arranging in lexicographical order, their first letters are compared. If they differ, then the string whose first letter comes earlier in the alphabet comes before the other string. If the first letters are the same, then the second letters are compared, and so on. If a position is reached where one string has no more letters to compare while the other does, then the first (shorter) string is deemed to come first in alphabetical order."

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- liftM read getLine
    forM_ [1..t] $ \_ -> do
        x <- liftM reverse getLine
        y <- liftM reverse getLine
        let firstYOne = length . takeWhile (== '0') $ y
        let nextXOne = length . takeWhile (== '0') $ drop firstYOne x
        print nextXOne

import Control.Monad
import Data.List
main = do
  t <- readLn
  replicateM_ t $ do
    x <- getLine
    y <- getLine
    let xl = elemIndex '1' (drop yl $ reverse x)
        Just yl = elemIndex '1' (reverse y)
    print $ maybe 0 id xl

f=length.fst.span('1'>);s[]=[];s(x:y:z)=(show$f$drop(f y)x):s z;main=interact$unlines.s.map reverse.tail.words


A and B are preparing themselves for programming contests.After several years of doing sports programming and solving many problems that require calculating all sorts of abstract objects, A and B also developed rather peculiar tastes.A likes lowercase letters of the Latin alphabet. He has assigned to each letter a number that shows how much he likes that letter (he has assigned negative numbers to the letters he dislikes). B likes substrings. He especially likes the ones that start and end with the same letter (their length must exceed one).Also, A and B have a string s. Now they are trying to find out how many substrings t of a string s are interesting to B (that is, t starts and ends with the same letter and its length is larger than one), and also the sum of values of all letters (assigned by A), except for the first and the last one is equal to zero.Naturally, A and B have quickly found the number of substrings t that are interesting to them. Can you do it?

The first line contains 26 integers xa, xb, ..., xz ( - 105 ≤ xi ≤ 105) — the value assigned to letters a, b, c, ..., z respectively. The second line contains string s of length between 1 and 105 characters, consisting of Lating lowercase letters— the string for which you need to calculate the answer.

NoteIn the first sample test strings satisfying the condition above are abca and bcab.In the second sample test strings satisfying the condition above are two occurences of aa.

import Data.Maybe
import Data.List
import Data.Int
import qualified Data.Map as Map

type Cimap = Map.Map Char Int64
type Iimap = Map.Map Int64 Int64

g :: String -> [Int64] -> Char -> Iimap
g a b c = gg a b c (Map.empty) where
	gg "" _ _ acc = acc
	gg (x:xs) (p:ps) c acc
		| c /= x = gg xs ps c acc
		| c == x = gg xs ps c (Map.alter (func) p acc) where
			func Nothing 	= Just 1
			func (Just x) 	= Just (x + 1)

q :: Iimap -> Iimap -> Int64
q a b = Map.foldWithKey (\k x ks -> ks + if k `Map.member` b then x * (b Map.! k) else 0) 0 a

ans :: Cimap -> String -> Int64
ans wf s = f s ( map (wf Map.!) s) where
	f "" _ = 0
	f [c] _ = 0
	f s wfm = f left leftwfm + f right rightwfm + mid where
		(left, right) = splitAt (length s `div` 2) s
		(leftwfm, rightwfm) = splitAt (length s `div` 2) wfm
		lmid = map (g (reverse left) (map (\x -> -x) $ scanl (+) 0 $ reverse leftwfm)) ['a'..'z']
		rmid = map (g right (scanl (+) 0 $ rightwfm))  ['a'..'z']
		mid = sum $ map (\(a,b) -> q a b) (zip lmid rmid)

main :: IO()
main = do
	a <- fmap (map read . words) getLine
	s <- getLine
	putStrLn $ (show $ ans (Map.fromList $ zip ['a'..'z'] a) s)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map.Strict as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  xs <- map (fromIntegral.readInt).B.words <$> B.getLine
  cs <- getLine
  print $ solve (listArray(0,25)xs) cs

solve :: UArray Int Int64 -> String -> Int64
solve xs cs = sum $ map solve' ['a'..'z']
   where
     !n = length cs

     arr :: UArray Int Int64
     arr = listArray(0, n - 1).tail$scanl(\acc c->acc + unsafeAt xs (fromEnum c - 97)) 0 cs

     solve' :: Char -> Int64
     solve' c0 = go 0 M.empty 0 cs
      where
        go !res !memo !i (c:cs)
          | c == c0 && i > 0 = case M.lookup (unsafeAt arr $ i - 1) memo of
                                 Just x -> go (res + x) (M.insertWith (+) (unsafeAt arr i) 1 memo) (i+1) cs
                                 Nothing -> go res (M.insertWith (+) (unsafeAt arr i) 1 memo) (i+1) cs
          | c /= c0 = go res memo (i + 1) cs
          | otherwise = go res (M.insert (unsafeAt arr i) 1 memo) (i + 1) cs
        go res _ _ [] = res

module Main (main) where

import Control.Monad
import Data.Functor
import Data.Char(ord)
import qualified Data.Map.Strict as Map

isDigit x = x=='-' || (x>='0' && x<='9')
split f l@(a:as) lft
	| f a = split f as (a:lft)
	| otherwise = (reverse lft, as)
split _ [] lft = (reverse lft, [])
readInts::String -> [Integer]
readInts [] = []
readInts l@(x:xs)
	| isDigit x = let (a, b) = split isDigit l [] in (read a):(readInts b)
	| otherwise = readInts xs

main = do
	wts <- Map.fromList . (zip ['a'..'z']) . readInts <$> getLine
	let mapping (w, _, _) c = ((+) w $ wts Map.! c, w, c)
	str <- scanl mapping (0, 0, '-') <$> getLine
	let
		fn (mp, sm) (ps, pps, c) = (mp', sm') where
			mp' = Map.insertWith (+) (ps, c) 1 mp
			sm' = (+) sm $ Map.findWithDefault 0 (pps, c) mp
	let res = snd $ foldl fn (Map.empty, 0) str
	print res


Anu has created her own function $$$f$$$: $$$f(x, y) = (x | y) - y$$$ where $$$|$$$ denotes the bitwise OR operation. For example, $$$f(11, 6) = (11|6) - 6 = 15 - 6 = 9$$$. It can be proved that for any nonnegative numbers $$$x$$$ and $$$y$$$ value of $$$f(x, y)$$$ is also nonnegative. She would like to research more about this function and has created multiple problems for herself. But she isn't able to solve all of them and needs your help. Here is one of these problems.A value of an array $$$[a_1, a_2, \dots, a_n]$$$ is defined as $$$f(f(\dots f(f(a_1, a_2), a_3), \dots a_{n-1}), a_n)$$$ (see notes). You are given an array with not necessarily distinct elements. How should you reorder its elements so that the value of the array is maximal possible?

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^9$$$). Elements of the array are not guaranteed to be different.

Output $$$n$$$ integers, the reordering of the array with maximum value. If there are multiple answers, print any.

import Data.Bits
main :: IO ()
main = do
  _ <- getLine
  as <- (map read.words) <$> getLine
  putStrLn $ (unwords.map show) $ solve as

type Situation = ([Indexed Value],Iterator)
type Iterator = Int
type Indexed a = (Int, a)
type Value = Int

solve :: [Int] -> [Int]
solve as =
  case mix of
    Just (ix,val) -> val : ( take ix as) ++ (drop (ix+1) as)
    Nothing -> as
  where
    mix = stelle (zip [0..] as, 29)

stelle :: Situation -> Maybe (Indexed Value)
stelle (_, -1) = Nothing
stelle (vals, i) =
  if (anzahl::Int) == 1
    then mIndex
    else stelle (vals, i-1)
  where
    (anzahl,mIndex) = foldr bin acc vals
    bin (ix,val) (count,m) =
      if testBit val i
        then
          (count+1,Just (ix,val))
        else
          (count,m)
    acc = (0,Nothing)

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

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

type EIO a = ExceptT String IO a

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

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

main_ :: EIO ()
main_ = do
    n <- get
    a <- replicateM n get
    putsln $ showList $ f1 n a

f1 :: Int -> [Int64] -> [Int64]
f1 n a =    let bitarray = runSTUArray $ do
                na <- newArray (0, 64) 0 :: ST s (STUArray s Int Int64)
                foldlM (\i c ->
                    do
                        forM_ (f2 c 0) (\x -> do
                        v <- readArray na x
                        if v == 0 then
                            writeArray na x (- i)
                        else
                            writeArray na x 1
                        )
                        return $ i + 1) 1 a
                return na
            in
            let maxb = foldl (\i j ->
                    if (bitarray ! j < 0) then ((- (bitarray ! j)) - 1) else i) 0 [0..63]
            in
            let changedList = runSTUArray $ do
                na <- newArray (0, n-1) 0 :: ST s (STUArray s Int Int64)
                foldlM (\i c -> do
                    writeArray na i c
                    return $ i + 1) 0 a
                v <- readArray na (fromIntegral maxb)
                v2 <- readArray na 0
                writeArray na 0 v
                writeArray na (fromIntegral maxb) v2
                return na
            in
            elems changedList

f2 :: Int64 -> Int -> [Int]
f2 c i =    if c == 0 then []
            else
                if (mod c 2) == 1 then i : (f2 (div c 2) (i + 1))
                else f2 (div c 2) (i + 1)

{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, ConstraintKinds,
UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import GHC.TypeLits (TypeError, ErrorMessage (Text))
import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (fromList, null, Seq( Empty ), (|>), (<|), (><), take)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

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

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

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

main_ :: EIO ()
main_ = do
    n <- get :: EIO Int
    a <- replicateM n get :: EIO [Int64]
    putln (f1 n a :: [Int64])

f1 :: Int -> [Int64] -> [Int64]
f1 n a =    let bitarray = runSTUArray $ do
                na <- newArray (0, 64) 0 :: ST s (STUArray s Int Int64)
                foldlM (\i c ->
                    do
                        forM_ (f2 c 0) (\x -> do
                        v <- readArray na x
                        if v == 0 then
                            writeArray na x (- i)
                        else
                            writeArray na x 1
                        )
                        return $ i + 1) 1 a
                return na
            in
            let maxb = foldl (\i j ->
                    if (bitarray ! j < 0) then ((- (bitarray ! j)) - 1) else i) 0 [0..63]
            in
            let changedList = runSTUArray $ do
                na <- newArray (0, n-1) 0 :: ST s (STUArray s Int Int64)
                foldlM (\i c -> do
                    writeArray na i c
                    return $ i + 1) 0 a
                v <- readArray na (fromIntegral maxb)
                v2 <- readArray na 0
                writeArray na 0 v
                writeArray na (fromIntegral maxb) v2
                return na
            in
            elems changedList

f2 :: Int64 -> Int -> [Int]
f2 c i =    if c == 0 then []
            else
                if (mod c 2) == 1 then i : (f2 (div c 2) (i + 1))
                else f2 (div c 2) (i + 1)

{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, ConstraintKinds,
UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import GHC.TypeLits (TypeError, ErrorMessage (Text))
import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (fromList, null, Seq( Empty ), (|>), (<|), (><), take)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

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

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toCharSeq :: a -> DSeq.Seq Char
    toString :: a -> String
    toString x = toList $ toCharSeq x

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convertEither = convertEitherp (undefined :: flag)
    toCharSeq = toCharSeqp (undefined :: flag)

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toCharSeqp :: flag -> a -> DSeq.Seq Char

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toCharSeqp _ x = DSeq.fromList $ show x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toCharSeqp _ x = DSeq.fromList x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toCharSeqp _ [] = DSeq.Empty
    toCharSeqp _ (x : xs) = foldl (\c i -> c DSeq.>< i) (toCharSeq x) (fmap (\x -> ' ' DSeq.<| (toCharSeq x)) xs)

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toString
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toString

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

main_ :: EIO ()
main_ = do
    n <- get :: EIO Int
    a <- replicateM n get :: EIO [Int64]
    putln (f1 n a :: [Int64])

f1 :: Int -> [Int64] -> [Int64]
f1 n a =    let bitarray = runSTUArray $ do
                na <- newArray (0, 64) 0 :: ST s (STUArray s Int Int64)
                foldlM (\i c ->
                    do
                        forM_ (f2 c 0) (\x -> do
                        v <- readArray na x
                        if v == 0 then
                            writeArray na x (- i)
                        else
                            writeArray na x 1
                        )
                        return $ i + 1) 1 a
                return na
            in
            let maxb = foldl (\i j ->
                    if (bitarray ! j < 0) then ((- (bitarray ! j)) - 1) else i) 0 [0..63]
            in
            let changedList = runSTUArray $ do
                na <- newArray (0, n-1) 0 :: ST s (STUArray s Int Int64)
                foldlM (\i c -> do
                    writeArray na i c
                    return $ i + 1) 0 a
                v <- readArray na (fromIntegral maxb)
                v2 <- readArray na 0
                writeArray na 0 v
                writeArray na (fromIntegral maxb) v2
                return na
            in
            elems changedList

f2 :: Int64 -> Int -> [Int]
f2 c i =    if c == 0 then []
            else
                if (mod c 2) == 1 then i : (f2 (div c 2) (i + 1))
                else f2 (div c 2) (i + 1)

{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, ConstraintKinds,
UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import Data.Ord
import Data.Int
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

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

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

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

main_ :: EIO ()
-- template --
main_ = do
    n <- get
    a <- replicateM n get
    putln $ f1 n a

f1 :: Int -> [Int64] -> [Int64]
f1 n a =    let bitarray = runSTUArray $ do
                na <- newArray (0, 64) 0 :: ST s (STUArray s Int Int64)
                foldlM (\i c ->
                    do
                        forM_ (f2 c 0) (\x -> do
                        v <- readArray na x
                        if v == 0 then
                            writeArray na x (- i)
                        else
                            writeArray na x 1
                        )
                        return $ i + 1) 1 a
                return na
            in
            let maxb = foldl (\i j ->
                    if (bitarray ! j < 0) then ((- (bitarray ! j)) - 1) else i) 0 [0..63]
            in
            let changedList = runSTUArray $ do
                na <- newArray (0, n-1) 0 :: ST s (STUArray s Int Int64)
                foldlM (\i c -> do
                    writeArray na i c
                    return $ i + 1) 0 a
                v <- readArray na (fromIntegral maxb)
                v2 <- readArray na 0
                writeArray na 0 v
                writeArray na (fromIntegral maxb) v2
                return na
            in
            elems changedList

f2 :: Int64 -> Int -> [Int]
f2 c i =    if c == 0 then []
            else
                if (mod c 2) == 1 then i : (f2 (div c 2) (i + 1))
                else f2 (div c 2) (i + 1)

{-# LANGUAGE TypeFamilies, TypeOperators, DataKinds, ConstraintKinds,
UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import GHC.TypeLits (TypeError, ErrorMessage (Text))
import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (fromList, null, Seq( Empty ), (|>), (<|), (><), take)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

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

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

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

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

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

main_ :: EIO ()
main_ = do
    n <- get :: EIO Int
    a <- replicateM n get :: EIO [Int64]
    putln (f1 n a :: [Int64])

f1 :: Int -> [Int64] -> [Int64]
f1 n a =    let bitarray = runSTUArray $ do
                na <- newArray (0, 64) 0 :: ST s (STUArray s Int Int64)
                foldlM (\i c ->
                    do
                        forM_ (f2 c 0) (\x -> do
                        v <- readArray na x
                        if v == 0 then
                            writeArray na x (- i)
                        else
                            writeArray na x 1
                        )
                        return $ i + 1) 1 a
                return na
            in
            let maxb = foldl (\i j ->
                    if (bitarray ! j < 0) then ((- (bitarray ! j)) - 1) else i) 0 [0..63]
            in
            let changedList = runSTUArray $ do
                na <- newArray (0, n-1) 0 :: ST s (STUArray s Int Int64)
                foldlM (\i c -> do
                    writeArray na i c
                    return $ i + 1) 0 a
                v <- readArray na (fromIntegral maxb)
                v2 <- readArray na 0
                writeArray na 0 v
                writeArray na (fromIntegral maxb) v2
                return na
            in
            elems changedList

f2 :: Int64 -> Int -> [Int]
f2 c i =    if c == 0 then []
            else
                if (mod c 2) == 1 then i : (f2 (div c 2) (i + 1))
                else f2 (div c 2) (i + 1)

import Data.Bits
main :: IO ()
main = do
  _ <- getLine
  as <- (map read.words) <$> getLine
  putStrLn $ (unwords.map show) $ solve as

type Situation = ([Indexed Value],Iterator)
type Iterator = Int
type Indexed a = (Int, a)
type Value = Int

solve :: [Int] -> [Int]
solve as =
  case mix of
    Just (ix,val) -> val : ( take ix as) ++ (drop (ix+1) as)
    Nothing -> as
  where
    mix = stelle (zip [0..] as, 28)

stelle :: Situation -> Maybe (Indexed Value)
stelle (_, -1) = Nothing
stelle (vals, i) =
  if (anzahl::Int) == 1
    then mIndex
    else stelle (vals, i-1)
  where
    (anzahl,mIndex) = foldr bin acc vals
    bin (ix,val) (count,m) =
      if testBit val i
        then
          (count+1,Just (ix,val))
        else
          (count,m)
    acc = (0,Nothing)


Winter is here at the North and the White Walkers are close. John Snow has an army consisting of n soldiers. While the rest of the world is fighting for the Iron Throne, he is going to get ready for the attack of the White Walkers.He has created a method to know how strong his army is. Let the i-th soldier’s strength be ai. For some k he calls i1, i2, ..., ik a clan if i1 < i2 < i3 < ... < ik and gcd(ai1, ai2, ..., aik) > 1 . He calls the strength of that clan k·gcd(ai1, ai2, ..., aik). Then he defines the strength of his army by the sum of strengths of all possible clans.Your task is to find the strength of his army. As the number may be very large, you have to print it modulo 1000000007 (109 + 7).Greatest common divisor (gcd) of a sequence of integers is the maximum possible integer so that each element of the sequence is divisible by it.

The first line contains integer n (1 ≤ n ≤ 200000) — the size of the army. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 1000000) — denoting the strengths of his soldiers.

Print one integer — the strength of John Snow's army modulo 1000000007 (109 + 7).

NoteIn the first sample the clans are {1}, {2}, {1, 2} so the answer will be 1·3 + 1·3 + 2·3 = 12

{-# 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.Trans.State.Lazy
import Control.Monad
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST.Safe
import Data.List
import Data.Int

main =  mapM_ print . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n poi
  return [solve n xs]
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve n xs = foldl' (\s i -> if c!i == 0 then s else (s + fromIntegral (c!i) * fromIntegral (a!i) `rem` fromIntegral d * fromIntegral (t!(c!i - 1))) `rem` fromIntegral d) (0 :: Int64) $ range b
  where
    m = maximum xs
    d = 1000000007
    b = (2, m)
    e = accumArray (+) 0 (1, m) $ zip xs (repeat 1) :: UArray Int Int
    c = listArray b [sum [e!(i * j) | j <- [1..m `quot` i]] | i <- range b] :: UArray Int Int
    a = runSTUArray $ do
      z <- newListArray b $ range b :: ST s (STUArray s Int Int)
      sequence_ [sequence_ [do { zi <- readArray z i; zt <- readArray z (i * j); writeArray z (i * j) (zt - zi) } | j <- [2..m `quot` i]] | i <- range b]
      return z
    t = listArray (0, m) $ iterate (\i -> i * 2 `rem` d) 1 :: UArray Int Int

{-# 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.Trans.State.Lazy
import Control.Monad
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST.Safe
import Data.List
import Data.Int

main =  print . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  solve `fmap` replicateM n poi
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve xs = foldl' (\s i -> if c!i == 0 then s else (s + fromIntegral (c!i) * fromIntegral (a!i) `rem` fromIntegral d * fromIntegral (t!(c!i - 1))) `rem` fromIntegral d) (0 :: Int64) $ range b
  where
    m = maximum xs
    d = 1000000007
    b = (2, m)
    e = accumArray (+) 0 (1, m) $ zip xs (repeat 1) :: UArray Int Int
    c = listArray b [sum [e!(i * j) | j <- [1..m `quot` i]] | i <- range b] :: UArray Int Int
    a = runSTUArray $ do
      z <- newListArray b $ range b :: ST s (STUArray s Int Int)
      sequence_ $ concat [[join $ liftM2 ((writeArray z (i * j) .) . subtract) (readArray z i) (readArray z (i * j)) | j <- [2..m `quot` i]] | i <- range b]
      return z
    t = listArray (0, m) $ iterate (\i -> i * 2 `rem` d) 1 :: UArray Int Int

{-# 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.Trans.State.Lazy
import Control.Monad
import Data.Array.Unboxed
import Data.List
import Data.Int

main =  mapM_ print . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n poi
  return [solve n xs]
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve n xs = foldl' (\s i -> if c!i == 0 then s else (s + fromIntegral (c!i) * fromIntegral (a!i) `rem` fromIntegral d * fromIntegral (t!(c!i - 1))) `rem` fromIntegral d) (0 :: Int64) $ range b
  where
    m = maximum xs
    d = 1000000007
    b = (2, m)
    e = accumArray (+) 0 (1, m) $ zip xs (repeat 1) :: UArray Int Int
    c = listArray b [sum [e!(i * j) | j <- [1..m `quot` i]] | i <- range b] :: UArray Int Int
    a = accumArray (+) 0 b $ concat [(i, i):[(i * j, -i) | j <- [2..m `quot` i]] | i <- range b] :: UArray Int Int
    t = listArray (0, m) $ iterate (\i -> i * 2 `rem` d) 1 :: UArray Int Int

{-# 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.Trans.State.Lazy
import Control.Monad
import Data.Array.Unboxed
import Data.List

main =  mapM_ print . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n poi
  return [solve n xs]
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve n xs = foldl' (\s i -> if c!i == 0 then s else (s + c!i * a!i `rem` d * t!(c!i - 1)) `rem` d) 0 $ range b
  where
    m = maximum xs
    d = 1000000007
    b = (2, m)
    e = accumArray (+) 0 (1, m) $ zip xs (repeat 1) :: UArray Int Int
    c = listArray b [sum [e!(i * j) | j <- [1..m `quot` i]] | i <- range b] :: UArray Int Int
    a = accumArray (+) 0 b $ concat [(i, i):[(i * j, -i) | j <- [2..m `quot` i]] | i <- range b] :: UArray Int Int
    t = listArray (0, m) $ iterate (\i -> i * 2 `rem` d) 1 :: UArray Int Int


Polycarp owns a shop in the capital of Berland. Recently the criminal activity in the capital increased, so Polycarp is thinking about establishing some better security in the storehouse of his shop.The storehouse can be represented as a matrix with n rows and m columns. Each element of the matrix is either . (an empty space) or x (a wall).Polycarp wants to hire some guards (possibly zero) to watch for the storehouse. Each guard will be in some cell of matrix and will protect every cell to the right of his own cell and every cell to the bottom of his own cell, until the nearest wall. More formally, if the guard is standing in the cell (x0, y0), then he protects cell (x1, y1) if all these conditions are met:  (x1, y1) is an empty cell;  either x0 = x1 and y0 ≤ y1, or x0 ≤ x1 and y0 = y1;  there are no walls between cells (x0, y0) and (x1, y1). There can be a guard between these cells, guards can look through each other. Guards can be placed only in empty cells (and can protect only empty cells). The plan of placing the guards is some set of cells where guards will be placed (of course, two plans are different if there exists at least one cell that is included in the first plan, but not included in the second plan, or vice versa). Polycarp calls a plan suitable if there is not more than one empty cell that is not protected.Polycarp wants to know the number of suitable plans. Since it can be very large, you have to output it modulo 109 + 7.

The first line contains two numbers n and m — the length and the width of the storehouse (1 ≤ n, m ≤ 250, 1 ≤ nm ≤ 250). Then n lines follow, ith line contains a string consisting of m characters — ith row of the matrix representing the storehouse. Each character is either . or x.

Output the number of suitable plans modulo 109 + 7.

NoteIn the first example you have to put at least one guard, so there are three possible arrangements: one guard in the cell (1, 1), one guard in the cell (1, 3), and two guards in both these cells.

-- 845F

{-# LANGUAGE FlexibleContexts #-}

import Data.List (transpose, foldl', foldl1')
import Data.Bits
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Control.Monad.ST.Safe (ST)
import Control.Monad (foldM)

type Index = (Int, Bool, Bool) -- mask, protected flag f1, missing flag f2

a +% b = (a + b) `mod` 1000000007
add :: STUArray s Index Int -> Index -> Int -> ST s (STUArray s Index Int)
add arr i v = do
  prev <- readArray arr i
  writeArray arr i $ prev +% v
  return arr

main = do
  (h:w:_) <- fmap (map read . words) getLine
  let (rotateInput, width) = if (w < h) then (id, w) else (transpose, h)
  interact $ output . program width . map (zip [0..]) . rotateInput . lines . filter (/= '\r')
      where output = show . (foldl1' (+%)) . elems

program :: Int -> [[(Int, Char)]] -> UArray Index Int
program width =
  let bounds = ((0, False, False), (bit width - 1, True, True))
  in foldl' (foldl' $ calcCell width) $ listArray bounds (1:repeat 0)

calcCell :: Int -> UArray Index Int -> (Int, Char) -> UArray Index Int
calcCell width lastRow (x, c) =
  let bounds = ((0, False, False), (bit width - 1, True, True))
  in runSTUArray $ do
    newRow <- newArray bounds 0
    foldM (advance (x, c, x == width - 1)) newRow $ assocs lastRow

advance :: (Int, Char, Bool) -> STUArray s Index Int -> (Index, Int) -> ST s (STUArray s Index Int)
advance (x, c, isLastX) arr i@((mask, f1, f2), ways)
  | ways == 0 = return arr
  | c == 'x'  = update (mask `clearBit` x, False, f2)
  | otherwise = addGuard >> skipGuard
    where update i = add arr i ways
          addGuard = update (mask `setBit` x, not isLastX, f2)
          skipGuard
            | protected || not f2 = update (mask, f1 && not isLastX, f2 || not protected)
            | otherwise           = return arr -- can't skip
          protected = f1 || mask `testBit` x

-- 845F

import Data.List (transpose)
import Data.Monoid (mconcat)

modN = 1000000007 :: Integer

data Cell = Wall | Cell { leftmost :: Bool
                        , topmost :: Bool
                        , rightEmpty :: Bool
                        , bottomEmpty :: Bool
                        }

main = getLine >> (interact $ show . program . input)
  where input = countCells . preprocessInput . lines

charToCell x
  | x == '.'  = Cell True True False False
  | otherwise = Wall

scan modify a b
  | null b    = [a]
  | otherwise =
    let (l, r) = f a (head b)
        f Wall r    = (Wall, r)
        f l    Wall = (l, Wall)
        f l    r    = modify l r
    in l:r:(tail b)

scanRow = foldr (scan (\(Cell l t _ b) (Cell _  t' r' b') -> (Cell l t True b   , Cell False t'    r' b'))) []
scanCol = foldr (scan (\(Cell l t r _) (Cell l' _  r' b') -> (Cell l t r    True, Cell l'    False r' b'))) []

preprocessInput :: [[Char]] -> [Cell]
preprocessInput = mconcat . map scanCol . transpose . map scanRow . (map . map) charToCell

countCells :: [Cell] -> (Integer, Integer, Integer, Integer)
countCells = foldr f (0, 0, 0, 0)
  where f Wall acc = acc
        f (Cell l t r b) (empty, zeroAdj, oneAdj, twoAdj)
          | not (l && t) = (empty + 1, zeroAdj, oneAdj, twoAdj)
          | (r && b)     = (empty, zeroAdj, oneAdj, twoAdj + 1)
          | (r || b)     = (empty, zeroAdj, oneAdj + 1, twoAdj)
          | otherwise    = (empty, zeroAdj + 1, oneAdj, twoAdj)

program :: (Integer, Integer, Integer, Integer) -> Int
program (empty, zeroAdj, oneAdj, twoAdj) = fromInteger (total `mod` modN)
  where total :: Integer
        total = (zeroAdj+1) * 2^empty
              + oneAdj      * 2^(max 0 (empty-1))
              + twoAdj      * 2^(max 0 (empty-2))


Kolya is going to make fresh orange juice. He has n oranges of sizes a1, a2, ..., an. Kolya will put them in the juicer in the fixed order, starting with orange of size a1, then orange of size a2 and so on. To be put in the juicer the orange must have size not exceeding b, so if Kolya sees an orange that is strictly greater he throws it away and continues with the next one.The juicer has a special section to collect waste. It overflows if Kolya squeezes oranges of the total size strictly greater than d. When it happens Kolya empties the waste section (even if there are no more oranges) and continues to squeeze the juice. How many times will he have to empty the waste section?

The first line of the input contains three integers n, b and d (1 ≤ n ≤ 100 000, 1 ≤ b ≤ d ≤ 1 000 000) — the number of oranges, the maximum size of the orange that fits in the juicer and the value d, which determines the condition when the waste section should be emptied. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 1 000 000) — sizes of the oranges listed in the order Kolya is going to try to put them in the juicer.

Print one integer — the number of times Kolya will have to empty the waste section.

NoteIn the first sample, Kolya will squeeze the juice from two oranges and empty the waste section afterwards.In the second sample, the orange won't fit in the juicer so Kolya will have no juice at all.

main :: IO ()
main = do
        firstLine <- getLine
        secondLine <- getLine

        let params = (map read . words) firstLine :: [Int]
        let oranges = (map read . words) secondLine :: [Int]
        let result = dumps (params !! 1) (params !! 2) 0 oranges
        print result

dumps :: (Integral a) => a -> a -> a -> [a] -> a
dumps b d currentlevel [] = 0 -- if the list is empty, vasya should not dump
dumps b d currentlevel (x:xs)
        | x > b = dumps b d currentlevel xs --the orange is larger
        | currentlevel + x > d = 1 + dumps b d 0 xs
        | otherwise = dumps b d (currentlevel + x) xs

import Numeric

fastRead :: String -> Integer
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.f.parse.words
parse = map fastRead

g [] y temp ans = ans
g (x:xs) y temp ans
  | (temp+x) > y = g xs y 0 (ans+1)
  | otherwise = g xs y (temp+x) ans

f (x:y:z:xs) = g (filter (<=y)  xs) z 0 0

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

f a _ tb  d [] = a + if tb > d then 1 else 0
f a b tb d (o:os) =
    if o > b
        then f a b tb d os
        else if tb > d
            then f (a+1) b o d os
            else f a b (o+tb) d os

ints = map (fst . fromJust . B.readInt) . B.words <$> B.getLine
main = do
    [n,b,d] <- ints
    as <- ints
    print $ f 0 b 0 d as

--ghc 8.0.1 /opt/ghc/8.0.1/lib/ghc-8.0.0.20160127/

solve n b d r xs
  | n == 0              = 0
  | (head) xs > b       = solve (n-1) b d r (tail xs)
  | r + (head xs) > d           = 1 + solve (n-1) b d 0 (tail xs)
  | otherwise           = solve (n-1) b d (r + head xs) (tail xs)

main = getLine >>= (return . map read . words) >>= \[n, b, d] ->
         getLine >>= (return . map read . words) >>= putStrLn . show . (solve n b d 0)

main = interact $ show . solve . map read . tail . words
solve (b:d:as) = go 0 $ filter (<= b) as where
  go _ [] = 0
  go v (a:as) | v' > d = 1 + go 0 as
              | otherwise = go v' as
    where v' = v + a

main = getContents >>= print . solve 0 0 . map read . words

solve cnt tmp (n:b:d:as)
    | null as = cnt
    | b < head as = solve cnt tmp (n:b:d:tail as)
    | tmp + head as <= d = solve cnt (tmp + head as) (n:b:d:tail as)
    | otherwise = solve (cnt + 1) 0 (n:b:d:tail as)

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

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

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  solve :: [Int] -> Int ->  Int -> Int -> Int -> Int
  solve [] _ _ _ accumulator = accumulator
  solve (x:xs) currentValue b d accumulator =
    let nextValue = currentValue + x
      in case (x <= b, nextValue > d) of
      (True, True) -> solve xs 0 b d (accumulator + 1)
      (True, False) -> solve xs nextValue b d accumulator
      (False, _) -> solve xs currentValue b d accumulator

  -- converting list to Set
  -- let mySet = S.fromList myList

  main :: IO()
  main = do
    [n,b,d] <- getLine >>= return . (map readInt) . words
    xs <- getLine >>= return . (map readInt) . words
    putStrLn $ show $ solve xs 0 b d 0
    -- n <- getLine >>= return . readInt
    -- putStrLn $ show $ solve [5,6] 0 7 10 0
    -- putStrLn "hello world"

main = do
    [n,b,d] <- return . map read . words =<< getLine
    oranges <- return . map read . words =<< getLine
    let acceptable = filter (<=b) oranges
	squeeze [] _ n = n
	squeeze (o:os) w n
	  | d < w+o	    = squeeze os 0 (n+1)
	  | otherwise	    = squeeze os (w+o) n
    print $ squeeze acceptable 0 0

calc :: [Int] -> Int -> Int -> Int
calc [] acum d     = if acum > d then 1 else 0
calc (x:xs) acum d = if acum > d then 1 + calc xs x d else calc xs (acum + x) d

process :: String -> String
process str =
  let [header, body] = lines str
      [n, b, d]      = map read $ words header
      a              = filter (<= b) . map read . take n . words $ body
  in show $ calc a 0 d

main :: IO ()
main = interact process

import Numeric

fastRead :: String -> Integer
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.f.parse.words
parse = map fastRead

g [] y temp ans = ans
g (x:xs) y temp ans
  | (temp+x) > y = g xs y 0 (ans+1)
  | otherwise = g xs y (temp+x) ans

f (x:y:z:xs) = g (filter (<y)  xs) z 0 0

import Numeric

fastRead :: String -> Integer
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ show.f.parse.words
parse = map fastRead

f (x:y:z:xs) = (sum (filter (<y)  xs)) `div` z

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

f a _ _  d td  [] = a + if td > d then 1 else 0
f a b tb w tw (o:os) =
    if o > b
        then f a b tb w tw os
        else if tw > w
            then f (a+1) b (o+tb) w 0 os
            else if (o+tb) > b
                then f a b 0 w (w+o+tb-b) os
                else f a b (o+tb) w tw os

ints = map (fst . fromJust . B.readInt) . B.words <$> B.getLine
main = do
    [n,b,d] <- ints
    as <- ints
    print $ f 0 b 0 d 0 as

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

f a _ _  _ d  [] = a + if d > 0 then 1 else 0
f a b tb w tw (o:os) =
    if o > b
        then f a b tb w tw os
        else if tw > w
            then f (a+1) b (o+tb) w 0 os
            else if (o+tb) > b
                then f a b 0 w (w+o+tb-b) os
                else f a b (o+tb) w tw os

ints = map (fst . fromJust . B.readInt) . B.words <$> B.getLine
main = do
    [n,b,d] <- ints
    as <- ints
    print $ f 0 b 0 d 0 as

main = getContents >>= print . solve 0 0 . map read . words

solve cnt tmp (n:b:d:as)
    | null as = cnt
    | b < head as = solve cnt tmp (n:b:d:tail as)
    | tmp + head as <= d = solve cnt (tmp + head as) (n:b:d:tail as)
    | otherwise = solve (cnt + 1) ((tmp + head as) `mod` d) (n:b:d:tail as)

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

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

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  solve :: [Int] -> Int ->  Int -> Int -> Int -> Int
  solve [] _ _ _ accumulator = accumulator
  solve (x:xs) currentValue b d accumulator =
    let nextValue = currentValue + x
      in case (x < b, nextValue > d) of
      (True, True) -> solve xs 0 b d (accumulator + 1)
      (True, False) -> solve xs nextValue b d accumulator
      (False, _) -> solve xs currentValue b d accumulator

  -- converting list to Set
  -- let mySet = S.fromList myList

  main :: IO()
  main = do
    [n,b,d] <- getLine >>= return . (map readInt) . words
    xs <- getLine >>= return . (map readInt) . words
    putStrLn $ show $ solve xs 0 b d 0
    -- n <- getLine >>= return . readInt
    -- putStrLn $ show $ solve [5,6] 0 7 10 0
    -- putStrLn "hello world"


You are living on an infinite plane with the Cartesian coordinate system on it. In one move you can go to any of the four adjacent points (left, right, up, down).More formally, if you are standing at the point $$$(x, y)$$$, you can:   go left, and move to $$$(x - 1, y)$$$, or  go right, and move to $$$(x + 1, y)$$$, or  go up, and move to $$$(x, y + 1)$$$, or  go down, and move to $$$(x, y - 1)$$$. There are $$$n$$$ boxes on this plane. The $$$i$$$-th box has coordinates $$$(x_i,y_i)$$$. It is guaranteed that the boxes are either on the $$$x$$$-axis or the $$$y$$$-axis. That is, either $$$x_i=0$$$ or $$$y_i=0$$$.You can collect a box if you and the box are at the same point. Find the minimum number of moves you have to perform to collect all of these boxes if you have to start and finish at the point $$$(0,0)$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 100$$$) — the number of boxes. The $$$i$$$-th line of the following $$$n$$$ lines contains two integers $$$x_i$$$ and $$$y_i$$$ ($$$-100 \le x_i, y_i \le 100$$$) — the coordinate of the $$$i$$$-th box. It is guaranteed that either $$$x_i=0$$$ or $$$y_i=0$$$. Do note that the sum of $$$n$$$ over all test cases is not bounded.

For each test case output a single integer — the minimum number of moves required.

NoteIn the first test case, a possible sequence of moves that uses the minimum number of moves required is shown below.  $$$$$$(0,0) \to (1,0) \to (1,1) \to (1, 2) \to (0,2) \to (-1,2) \to (-1,1) \to (-1,0) \to (-1,-1) \to (-1,-2) \to (0,-2) \to (0,-1) \to (0,0)$$$$$$ In the second test case, a possible sequence of moves that uses the minimum number of moves required is shown below.  $$$$$$(0,0) \to (0,1) \to (0,2) \to (-1, 2) \to (-2,2) \to (-3,2) \to (-3,1) \to (-3,0) \to (-3,-1) \to (-2,-1) \to (-1,-1) \to (0,-1) \to (0,0)$$$$$$ In the third test case, we can collect all boxes without making any moves.

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n] <- ri
        replicateM n ri
    mapM_ (putStrLn.show.solve) tcs

solve boxes = 2 * ((-minX) + (-minY) + maxX + maxY)
  where
    minX = min 0 . minimum . map head $ boxes
    maxX = max 0 . maximum . map head $ boxes
    minY = min 0 . minimum . map last $ boxes
    maxY = max 0 . maximum . map last $ boxes

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

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

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

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

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

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x

-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> [(Int, Int)] -> Int
solve n points = 2 * ((maximum xs - minimum xs) + (maximum ys - minimum ys))
    where
        xs = 0 : map fst points
        ys = 0 : map snd points

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        points <- replicateM n $ do
            [x, y] <- B8.getLine <&> readIntB8s
            return (x, y)
        let answer = solve n points
        printf "%d\n" answer