Little town Nsk consists of n junctions connected by m bidirectional roads. Each road connects two distinct junctions and no two roads connect the same pair of junctions. It is possible to get from any junction to any other junction by these roads. The distance between two junctions is equal to the minimum possible number of roads on a path between them.In order to improve the transportation system, the city council asks mayor to build one new road. The problem is that the mayor has just bought a wonderful new car and he really enjoys a ride from his home, located near junction s to work located near junction t. Thus, he wants to build a new road in such a way that the distance between these two junctions won't decrease. You are assigned a task to compute the number of pairs of junctions that are not connected by the road, such that if the new road between these two junctions is built the distance between s and t won't decrease.

The firt line of the input contains integers n, m, s and t (2 ≤ n ≤ 1000, 1 ≤ m ≤ 1000, 1 ≤ s, t ≤ n, s ≠ t) — the number of junctions and the number of roads in Nsk, as well as the indices of junctions where mayors home and work are located respectively. The i-th of the following m lines contains two integers ui and vi (1 ≤ ui, vi ≤ n, ui ≠ vi), meaning that this road connects junctions ui and vi directly. It is guaranteed that there is a path between any two junctions and no two roads connect the same pair of junctions.

Print one integer — the number of pairs of junctions not connected by a direct road, such that building a road between these two junctions won't decrease the distance between junctions s and t.

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

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  s <- poi
  t <- poi
  g <- replicateM m $ liftM2 (,) poi poi
  return $ show $ solve n m s t g
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n m s t (accumArray (flip (:)) [] (1, n) . concatMap (\(a, b) -> [(a, b), (b, a)]) -> g) | ds <- bfs s g, dt <- bfs t g, Just c <- M.lookup t ds = sum [1 :: Int | (u, v) <- pairs [1..n], fromMaybe False $ liftM4 (\su sv ut vt -> su + vt + 1 >= c && sv + ut + 1 >= c) (M.lookup u ds) (M.lookup v ds) (M.lookup u dt) (M.lookup v dt)] - m

bfs s = go 0 [s] M.empty
  where
  go _ [] m _ = m
  go d us m g | m' <- foldl' (flip (`M.insert` d)) m us  = (\us' -> go (d + 1) us' m' g) $ filter (not . flip M.member m') $ concatMap (g!) us

pairs xs = [(a, b) | (a:bs) <- tails xs, b <- bs]

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE ViewPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Strict
import Data.Array
import Data.List
import Data.Maybe
import qualified Data.IntSet as S
import qualified Data.IntMap as M

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  s <- poi
  t <- poi
  g <- replicateM m $ liftM2 (,) poi poi
  return $ show $ solve n s t g
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n s t (accumArray (flip S.insert) S.empty (1, n) . concatMap (\(a, b) -> [(a, b), (b, a)]) -> g) | ds <- bfs s g, dt <- bfs t g, Just c <- M.lookup t ds = sum [1 :: Int | (u, v) <- pairs [1..n], S.notMember u (g!v), fromMaybe False $ liftM4 (\su sv ut vt -> su + vt + 1 >= c && sv + ut + 1 >= c) (M.lookup u ds) (M.lookup v ds) (M.lookup u dt) (M.lookup v dt)]

bfs s = go 0 [s] M.empty
  where
  go _ [] m _ = m
  go d us m g | m' <- foldl' (flip (`M.insert` d)) m us  = (\us' -> go (d + 1) us' m' g) $ filter (not . flip M.member m') $ concatMap (S.toList . (g!)) us

pairs xs = [(a, b) | (a:bs) <- tails xs, b <- bs]

module Main where

import Control.Monad
import Control.Applicative
import Data.List
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Maybe(fromMaybe)

type Cost = Int
type Vertex = Int
type Edge = ((Vertex, Vertex), Cost)

main = do
 [n, m, s, t] <- map (read:: String -> Int) . words <$> getLine
 roads <- map (tuple . sort . map (read:: String -> Int) . words) . lines <$> getContents
 print . length . possible n (s, t) . S.fromList $ zip roads [1, 1..]

possible:: Int -> (Vertex, Vertex) -> S.Set Edge -> [Edge]
possible n (s, g) edge = let sDist = dijkstra n s edge
                             gDist = dijkstra n g edge
                             originalTime = sDist ! g
                         in
                          do
                           l <- [1..n - 1]
                           r <- [l + 1..n]
                           guard $ ((l, r), 1) `S.notMember` edge
                           let route1 = sDist ! l + gDist ! r + 1
                               route2 = sDist ! r + gDist ! l + 1
                           guard $ min route1 route2 >= originalTime
                           return ((l, r), 1)

dijkstra::Int -> Vertex -> S.Set Edge -> UArray Vertex Cost
dijkstra n s edge = let connect = foldl' (\ cMap ((a, b), c) -> insertList a b c cMap) (M.fromList [(x, []) | x <- [1..n]]) $ S.toList edge
                        costArray = runSTUArray $ do
                                                   mArray <- newArray (1, n) maxBound :: ST s (STUArray s Vertex Cost)
                                                   let reachable = fromMaybe (error "key error") $ M.lookup s connect
                                                   forM_ reachable $ uncurry (writeArray mArray)
                                                   return mArray
                        costSet = S.delete (maxBound::Int, s) . S.fromList . map (\ (a, b) -> (b, a)) $ assocs costArray
                     in runSTUArray $ do
                                       mArray <- thaw costArray
                                       loop s connect costSet mArray
                                       return mArray

loop:: Vertex -> M.Map Vertex [(Vertex, Cost)] -> S.Set (Cost, Vertex) -> STUArray s Vertex Cost -> ST s ()
loop s connect costSet costArray = if S.null costSet then writeArray costArray s 0
                                                     else do
                                                           let (minCost, minVertex) = S.findMin costSet
                                                               reachable = fromMaybe (error "key error") $ M.lookup minVertex connect
                                                           newCostSet <- foldM (\ cSet (v, c) -> do
                                                                                let newCost = minCost + c
                                                                                oldCost <- readArray costArray v
                                                                                if newCost < oldCost then do
                                                                                writeArray costArray v newCost
                                                                                return $ S.insert (newCost, v) $ S.delete (oldCost, v) cSet
                                                                                else return cSet) (S.deleteMin costSet) reachable
                                                           loop s connect newCostSet costArray

insertList:: Vertex -> Vertex -> Cost -> M.Map Vertex [(Vertex, Cost)] -> M.Map Vertex [(Vertex, Cost)]
insertList a b c = M.update (\ x -> Just $ (a, c):x) b . M.update (\x -> Just $ (b, c):x) a

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

module Main where

import Control.Monad
import Control.Applicative
import Data.List
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Maybe(fromMaybe)

type Cost = Int
type Vertex = Int
type Edge = ((Vertex, Vertex), Cost)

main = do
 [n, m, s, t] <- map (read:: String -> Int) . words <$> getLine
 roads <- map (tuple . sort . map (read:: String -> Int) . words) . lines <$> getContents
 print . length . possible n (s, t) . S.fromList $ zip roads [1, 1..]

possible:: Int -> (Vertex, Vertex) -> S.Set Edge -> [Edge]
possible n (s, g) edge = let sDist = dijkstra n s edge
                             gDist = dijkstra n g edge
                             originalTime = sDist ! g
                         in
                          do
                           l <- [1..n - 1]
                           r <- [l + 1..n]
                           guard $ ((l, r), 1) `S.notMember` edge
                           let route1 = sDist ! l + gDist ! r + 1
                               route2 = sDist ! r + gDist ! l + 1
                           guard $ min route1 route2 >= originalTime
                           return ((l, r), 1)

dijkstra::Int -> Vertex -> S.Set Edge -> UArray Vertex Cost
dijkstra n s edge = let connect = foldl' (\ cMap ((a, b), c) -> insertMap a b c cMap) (M.fromList [(x, S.empty) | x <- [1..n]]) $ S.toList edge
                        costArray = runSTUArray $ do
                                                   mArray <- newArray (1, n) maxBound :: ST s (STUArray s Vertex Cost)
                                                   let reachable = S.toList . fromMaybe (error "key error") $ M.lookup s connect
                                                   forM_ reachable $ uncurry (writeArray mArray)
                                                   return mArray
                        costSet = S.delete (maxBound::Int, s) . S.fromList . map (\ (a, b) -> (b, a)) $ assocs costArray
                     in runSTUArray $ do
                                       mArray <- thaw costArray
                                       loop s connect costSet mArray
                                       return mArray

loop:: Vertex -> M.Map Vertex (S.Set (Vertex, Cost)) -> S.Set (Cost, Vertex) -> STUArray s Vertex Cost -> ST s ()
loop s connect costSet costArray = if S.null costSet then writeArray costArray s 0
                                                     else do
                                                           let (minCost, minVertex) = S.findMin costSet
                                                               reachable = S.toList $ fromMaybe (error "key error") $ M.lookup minVertex connect
                                                           newCostSet <- foldM (\ cSet (v, c) -> do
                                                                                let newCost = minCost + c
                                                                                oldCost <- readArray costArray v
                                                                                if newCost < oldCost then do
                                                                                writeArray costArray v newCost
                                                                                return $ S.insert (newCost, v) $ S.delete (oldCost, v) cSet
                                                                                else return cSet) (S.deleteMin costSet) reachable
                                                           loop s connect newCostSet costArray

insertMap:: Vertex -> Vertex -> Cost -> M.Map Vertex (S.Set (Vertex, Cost)) -> M.Map Vertex (S.Set (Vertex, Cost))
insertMap a b c = M.update (\ x -> Just $ S.insert (a, c) x) b . M.update (\x -> Just $ S.insert (b, c) x) a

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

module Main where

import Control.Monad
import Control.Applicative
import Data.List
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Maybe(fromMaybe)

type Cost = Int
type Vertex = Int
type Edge = (Vertex, Vertex)

main = do
 [n, m, s, t] <- map (read:: String -> Int) . words <$> getLine
 roads <- map (tuple . sort . map (read:: String -> Int) . words) . lines <$> getContents
 print . length . possible n (s, t) $ S.fromList roads

possible:: Int -> (Vertex, Vertex) -> S.Set Edge -> [Edge]
possible n (s, g) edge = let sDist = bfs n s edge
                             gDist = bfs n g edge
                             originalTime = sDist ! g
                         in do
                             start <- [1..n - 1]
                             end <- [start + 1..n]
                             guard $ (start, end) `S.notMember` edge
                             let route1 = sDist ! start + gDist ! end + 1
                                 route2 = sDist ! end + gDist ! start + 1
                             guard $ route1 >= originalTime && route2 >= originalTime
                             return (start, end)

bfs:: Int -> Vertex -> S.Set Edge -> UArray Vertex Cost
bfs n s edge = let connect = foldl' (\ cMap (a, b) -> update a b cMap) (M.fromList [(x, S.empty) | x <- [1..n]]) $ S.toList edge
                   queue = (s, 0):walk 1 queue connect (S.fromList [s])
               in array (1, n) queue

walk:: Int -> [(Vertex, Cost)] -> M.Map Vertex (S.Set Vertex) -> S.Set Vertex -> [(Vertex, Cost)]
walk 0 _ _ used = []
walk n ((v, c):rest) connect used = let reachable = fromMaybe (error "key error") $ M.lookup v connect
                                        unreached = S.toList $ S.filter (`S.notMember` used) reachable
                                        add = zip unreached [c + 1, c + 1..]
                                        newUsed = foldl' (flip S.insert) used unreached
                                    in add ++ walk (n + length add - 1) rest connect newUsed

update:: Vertex -> Vertex -> M.Map Vertex (S.Set Vertex) -> M.Map Vertex (S.Set Vertex)
update a b = M.update (\ x -> Just $ S.insert a x) b . M.update (\x -> Just $ S.insert b x) a

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

module Main where

import Control.Monad
import Control.Applicative
import Data.List
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.Set as S
import qualified Data.Map as M

type Cost = Int
type Vertex = Int
type Edge = ((Vertex, Vertex), Cost)

main = do
 [n, m, s, t] <- map (read:: String -> Int) . words <$> getLine
 roads <- map (tuple . sort . map (read:: String -> Int) . words) . lines <$> getContents
 print . length . possible n (s, t) . S.fromList $ zip roads [1,1..]

possible:: Int -> (Vertex, Vertex) -> S.Set Edge -> [Edge]
possible n (s, g) edge = let sDist = dijkstra n s edge
                             gDist = dijkstra n g edge
                             originalTime = sDist ! g
                         in do
                             start <- [1..n - 1]
                             end <- [start + 1..n]
                             guard $ ((start, end), 1) `S.notMember` edge
                             let route1 = sDist ! start + gDist ! end + 1
                                 route2 = sDist ! end + gDist ! start + 1
                             guard $ route1 >= originalTime && route2 >= originalTime
                             return ((start, end), 1)

dijkstra::Int -> Vertex -> S.Set Edge -> UArray Vertex Cost
dijkstra n s edge = let initialArray = runSTUArray $ do
                                                      mArray <- newArray (1, n) maxBound :: ST s (STUArray s Int Int)
                                                      let reachable = S.toList . omit s $ S.filter (\ ((a, b), c) -> a == s || b == s) edge
                                                      forM_ reachable $ uncurry (writeArray mArray)
                                                      return mArray
                        initialSet = S.delete (maxBound::Int, s) . S.fromList . map (\ (a, b) -> (b, a)) $ assocs initialArray
                        initialMap = M.delete s . M.fromList $ assocs initialArray
                    in array (1, n) . M.toList $ recursive s edge initialSet initialMap M.empty

recursive::Vertex -> S.Set Edge -> S.Set (Cost, Vertex) -> M.Map Vertex Cost -> M.Map Vertex Cost -> M.Map Vertex Cost
recursive s edge costSet costMap distMap
 | S.null costSet = M.insert s 0 distMap
 | otherwise = let (minCost, minVertex) = S.findMin costSet
                   newDistMap = M.insert minVertex minCost distMap
                   neighbors = S.toList . omit minVertex $ S.filter (\ ((a, b), c) -> a == minVertex || b == minVertex) edge
                   (newCostSet, newCostMap) = foldl' (\ (cSet, cMap) (a, c) -> case M.lookup a cMap of
                                                                                Just oldCost -> if minCost + c < oldCost
                                                                                then (S.insert (minCost + c, a) $ S.delete (oldCost, a) cSet, M.update (\_ -> Just $ minCost + c) a cMap)
                                                                                else (cSet, cMap)
                                                                                Nothing -> (cSet, cMap))
                                               (S.delete (minCost, minVertex) costSet, M.delete minVertex costMap) neighbors
               in recursive s edge newCostSet newCostMap newDistMap

omit::Vertex -> S.Set Edge -> S.Set (Vertex, Cost)
omit x = S.map (\ ((a, b), c) -> if a == x then (b, c) else (a, c))

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

module Main where

import Control.Monad
import Control.Applicative
import Data.List
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Maybe(fromMaybe)

type Cost = Int
type Vertex = Int
type Edge = (Vertex, Vertex)

main = do
 [n, m, s, t] <- map (read:: String -> Int) . words <$> getLine
 roads <- map (tuple . sort . map (read:: String -> Int) . words) . lines <$> getContents
 print . length . possible n (s, t) $ S.fromList roads

possible:: Int -> (Vertex, Vertex) -> S.Set Edge -> [Edge]
possible n (s, g) edge = let sDist = bfs n s edge
                             gDist = bfs n g edge
                             originalTime = sDist ! g
                         in do
                             start <- [1..n - 1]
                             end <- [start + 1..n]
                             guard $ (start, end) `S.notMember` edge
                             let route1 = sDist ! start + gDist ! end + 1
                                 route2 = sDist ! end + gDist ! start + 1
                             guard $ route1 >= originalTime && route2 >= originalTime
                             return (start, end)

bfs:: Int -> Vertex -> S.Set Edge -> UArray Vertex Cost
bfs n s edge = let connect = foldl' (\ cMap (a, b) -> update a b cMap) (M.fromList [(x, S.empty) | x <- [1..n]]) $ S.toList edge
                   queue = (s, 0):walk n queue connect (S.fromList [s])
               in array (1, n) queue

walk:: Int -> [(Vertex, Cost)] -> M.Map Vertex (S.Set Vertex) -> S.Set Vertex -> [(Vertex, Cost)]
walk n _ _ used
 | S.size used == n = []
walk n ((v, c):rest) connect used = let reachable = fromMaybe (error "key error") $ M.lookup v connect
                                        unreached = S.toList $ S.filter (\x -> x `S.notMember` used) reachable
                                        add = zip unreached [c + 1, c + 1..]
                                        newUsed = foldl' (\ set x -> S.insert x set) used unreached
                                    in if null add then walk n rest connect newUsed
                                                   else add ++ walk n rest connect newUsed

update:: Vertex -> Vertex -> M.Map Vertex (S.Set Vertex) -> M.Map Vertex (S.Set Vertex)
update a b = M.update (\ x -> Just $ S.insert a x) b . M.update (\x -> Just $ S.insert b x) a

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

module Main where

import Control.Monad
import Control.Applicative
import Data.List
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.Set as S
import qualified Data.Map as M

type Cost = Int
type Vertex = Int
type Edge = ((Vertex, Vertex), Cost)

main = do
 [n, m, s, t] <- map (read:: String -> Int) . words <$> getLine
 roads <- map (tuple . sort . map (read:: String -> Int) . words) . lines <$> getContents
 print . length . possible n (s, t) . S.fromList $ zip roads [1,1..]

possible:: Int -> (Vertex, Vertex) -> S.Set Edge -> [Edge]
possible n (s, g) edge = let sDist = dijkstra n s edge
                             gDist = dijkstra n g edge
                             originalTime = sDist ! g
                         in do
                             start <- [1..n - 1]
                             end <- [start + 1..n]
                             guard $ ((start, end), 1) `S.notMember` edge
                             let route1 = sDist ! start + gDist ! end + 1
                                 route2 = sDist ! end + gDist ! start + 1
                             guard $ route1 >= originalTime && route2 >= originalTime
                             return ((start, end), 1)

dijkstra::Int -> Vertex -> S.Set Edge -> UArray Vertex Cost
dijkstra n s edge = let initialArray = runSTUArray $ do
                                                      mArray <- newArray (1, n) maxBound :: ST s (STUArray s Int Int)
                                                      let reachable = S.toList . omit s $ S.filter (\ ((a, b), c) -> a == s || b == s) edge
                                                      forM_ reachable $ uncurry (writeArray mArray)
                                                      return mArray
                        initialSet = S.delete (maxBound::Int, s) . S.fromList . map (\ (a, b) -> (b, a)) $ assocs initialArray
                        initialMap = M.delete s . M.fromList $ assocs initialArray
                    in array (1, n) . M.toList $ recursive s edge initialSet initialMap M.empty

recursive::Vertex -> S.Set Edge -> S.Set (Cost, Vertex) -> M.Map Vertex Cost -> M.Map Vertex Cost -> M.Map Vertex Cost
recursive s edge costSet costMap distMap
 | S.null costSet = M.insert s 0 distMap
 | otherwise = let (minCost, minVertex) = S.findMin costSet
                   newDistMap = M.insert minVertex minCost distMap
                   neighbors = S.toList . omit minVertex $ S.filter (\ ((a, b), c) -> a == minVertex || b == minVertex) edge
                   (newCostSet, newCostMap) = foldl' (\ (cSet, cMap) (a, c) -> case M.lookup a cMap of
                                                                                Just cost -> if minCost + c < cost then update a (minCost + c) cSet cMap else (cSet, cMap)
                                                                                Nothing -> (cSet, cMap))
                                               (S.delete (minCost, minVertex) costSet, M.delete minVertex costMap) neighbors
               in recursive s edge newCostSet newCostMap newDistMap

update::Vertex -> Cost -> S.Set (Cost, Vertex) -> M.Map Vertex Cost -> (S.Set (Cost, Vertex), M.Map Vertex Cost)
update a newCost costSet costMap = case M.lookup a costMap of
                                    Just oldCost -> (S.insert (newCost, a) $ S.delete (oldCost, a) costSet, M.update (\_ -> Just newCost) a costMap)
                                    Nothing -> error "key doesn't exist"

omit::Vertex -> S.Set Edge -> S.Set (Vertex, Cost)
omit x = S.map (\ ((a, b), c) -> if a == x then (b, c) else (a, c))

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

import Control.Monad
import Control.Applicative
import Data.List
import Data.Maybe
import Data.Function (fix)
import Data.Array (Array, array, (!))
import qualified Data.Sequence as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInts :: IO [Int]
getInts = (map parseInt . BS8.words) <$> BS.getLine
    where parseInt = fst . fromJust . BS8.readInt

bfsDo :: [(Int, Int)] -> Int -> Int -> S.Seq Int
bfsDo edges s n = bfs edges (S.singleton s) (S.update s 0 $ S.fromList (replicate n (-1)))

a !. b = a `S.index` b

bfs :: [(Int, Int)] -> S.Seq Int -> S.Seq Int -> S.Seq Int
bfs edges q d
    | S.null q = d
    | otherwise = let now = q !. 0
                      nowDist = d !. now
                      nexts = map snd $ filter (\(a,b) -> a == now && d !. b == -1) edges in
                      bfs edges ((S.drop 1 q) S.>< (S.fromList nexts)) (foldl (\ad n -> S.update n (nowDist +1) ad) d nexts)

solve :: [(Int, Int)] -> Int -> Int -> Int -> Int
solve edges n s t = dcount - length edges `div` 2
    where sdist = bfsDo edges s n
          tdist = bfsDo edges t n
          st = sdist !. t
          minDist x y = min (sdist !. x + 1 + tdist !. y) (sdist !. y + 1 + tdist !. x)
          dcount = length $ filter (\(x,y) -> minDist x y >= st) $ [(x,y) | x <- [0..n-1], y <- [x+1..n-1]]

main :: IO ()
main = do
    [n,m,s,t] <- getInts
    edges <- concat <$> replicateM m (getInts >>= (\[a,b] -> pure [(a-1,b-1),(b-1,a-1)]))
    print $ solve edges n (s-1) (t-1)

module Main where

import Control.Monad
import Control.Applicative
import Data.List
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Maybe(fromMaybe)
import qualified Data.Set as S
import qualified Data.Map as M

type Cost = Int
type Vertex = Int
type Edge = ((Vertex, Vertex), Cost)

main = do
 [n, m, s, t] <- map (read:: String -> Int) . words <$> getLine
 roads <- map (tuple . map (read:: String -> Int) . words) . lines <$> getContents
 print . length . possible n (s, t) . S.fromList $ zip roads [1, 1..]

possible:: Int -> (Vertex, Vertex) -> S.Set Edge -> [Edge]
possible n (s, g) edge = let sDist = dijkstra n s edge
                             gDist = dijkstra n g edge
                             originalTime = fromMaybe (error "unreachable") $ M.lookup g sDist
                         in do
                             start <- [1..n - 1]
                             end <- [start + 1..n]
                             guard $ ((start, end), 1) `S.notMember` edge
                             let route1 = fromMaybe (error "unreachable") (M.lookup start sDist) + fromMaybe (error "unreachable") (M.lookup end gDist) + 1
                                 route2 = fromMaybe (error "unreachable") (M.lookup end sDist) + fromMaybe (error "unreachable") (M.lookup start gDist) + 1
                             guard $ route1 >= originalTime && route2 >= originalTime
                             return ((start, end), 1)

dijkstra::Int -> Vertex -> S.Set Edge -> M.Map Vertex Cost
dijkstra n s edge = let initialArray = runSTUArray $ do
                                                      mArray <- newArray (1, n) maxBound :: ST s (STUArray s Int Int)
                                                      let reachable = S.toList . omit s $ S.filter (\ ((a, b), c) -> a == s || b == s) edge
                                                      forM_ reachable $ uncurry (writeArray mArray)
                                                      return mArray
                        initialSet = S.delete (maxBound::Int, s) . S.fromList . map (\ (a, b) -> (b, a)) $ assocs initialArray
                        initialMap = M.fromList $ assocs initialArray
                    in recursive s edge initialSet initialMap M.empty

recursive::Vertex -> S.Set Edge -> S.Set (Cost, Vertex) -> M.Map Vertex Cost -> M.Map Vertex Cost -> M.Map Vertex Cost
recursive s edge costSet costMap distMap
 | S.null costSet = M.insert s 0 distMap
 | otherwise = let (minCost, minVertex) = S.findMin costSet
                   newDistMap = M.insert minVertex minCost distMap
                   neighbors = S.toList . omit minVertex $ S.filter (\ ((a, b), c) -> a == minVertex || b == minVertex) edge
                   (newCostSet, newCostMap) = foldl' (\ (cSet, cMap) (a, c) -> case M.lookup a cMap of
                                                                                Just cost -> if minCost + c < cost then update a (minCost + c) cSet cMap else (cSet, cMap)
                                                                                Nothing -> (cSet, cMap))
                                               (S.delete (minCost, minVertex) costSet, M.delete minVertex costMap) neighbors
               in recursive s edge newCostSet newCostMap newDistMap

update::Vertex -> Cost -> S.Set (Cost, Vertex) -> M.Map Vertex Cost -> (S.Set (Cost, Vertex), M.Map Vertex Cost)
update a c costSet costMap = case M.lookup a costMap of
                              Just oldCost -> (S.insert (c, a) $ S.delete (oldCost, a) costSet, M.update (\_ -> Just c) a costMap)
                              Nothing -> error "key doesn't exist"

omit::Vertex -> S.Set Edge -> S.Set (Vertex, Cost)
omit x = S.map (\ ((a, b), c) -> if a == x then (b, c) else (a, c))

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

module Main where

import Control.Monad
import Control.Applicative
import Data.List
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Maybe(fromMaybe)
import qualified Data.Set as S
import qualified Data.Map as M

type Cost = Int
type Vertex = Int
type Edge = ((Vertex, Vertex), Cost)

main = do
 [n, m, s, t] <- map (read:: String -> Int) . words <$> getLine
 roads <- map (tuple . map (read:: String -> Int) . words) . lines <$> getContents
 print . length . possible n (s, t) . S.fromList $ zip roads [1, 1..]

possible:: Int -> (Vertex, Vertex) -> S.Set Edge -> [Edge]
possible n (s, g) edge = let sDist = dijkstra n s edge
                             gDist = dijkstra n g edge
                             originalTime = sDist ! g
                         in do
                             start <- [1..n - 1]
                             end <- [start + 1..n]
                             guard $ ((start, end), 1) `S.notMember` edge
                             let route1 = sDist ! start + gDist ! end + 1
                                 route2 = sDist ! end + gDist ! start + 1
                             guard $ route1 >= originalTime && route2 >= originalTime
                             return ((start, end), 1)

dijkstra::Int -> Vertex -> S.Set Edge -> UArray Vertex Cost
dijkstra n s edge = let initialArray = runSTUArray $ do
                                                      mArray <- newArray (1, n) maxBound :: ST s (STUArray s Int Int)
                                                      let reachable = S.toList . omit s $ S.filter (\ ((a, b), c) -> a == s || b == s) edge
                                                      forM_ reachable $ uncurry (writeArray mArray)
                                                      return mArray
                        initialSet = S.delete (maxBound::Int, s) . S.fromList . map (\ (a, b) -> (b, a)) $ assocs initialArray
                        initialMap = M.fromList $ assocs initialArray
                    in array (1, n) . M.toList $ recursive s edge initialSet initialMap M.empty

recursive::Vertex -> S.Set Edge -> S.Set (Cost, Vertex) -> M.Map Vertex Cost -> M.Map Vertex Cost -> M.Map Vertex Cost
recursive s edge costSet costMap distMap
 | S.null costSet = M.insert s 0 distMap
 | otherwise = let (minCost, minVertex) = S.findMin costSet
                   newDistMap = M.insert minVertex minCost distMap
                   neighbors = S.toList . omit minVertex $ S.filter (\ ((a, b), c) -> a == minVertex || b == minVertex) edge
                   (newCostSet, newCostMap) = foldl' (\ (cSet, cMap) (a, c) -> case M.lookup a cMap of
                                                                                Just cost -> if minCost + c < cost then update a (minCost + c) cSet cMap else (cSet, cMap)
                                                                                Nothing -> (cSet, cMap))
                                               (S.delete (minCost, minVertex) costSet, M.delete minVertex costMap) neighbors
               in recursive s edge newCostSet newCostMap newDistMap

update::Vertex -> Cost -> S.Set (Cost, Vertex) -> M.Map Vertex Cost -> (S.Set (Cost, Vertex), M.Map Vertex Cost)
update a c costSet costMap = case M.lookup a costMap of
                              Just oldCost -> (S.insert (c, a) $ S.delete (oldCost, a) costSet, M.update (\_ -> Just c) a costMap)
                              Nothing -> error "key doesn't exist"

omit::Vertex -> S.Set Edge -> S.Set (Vertex, Cost)
omit x = S.map (\ ((a, b), c) -> if a == x then (b, c) else (a, c))

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

module Main where

import Control.Monad
import Control.Applicative
import Data.List
import Control.Monad.ST.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.Set as S
import qualified Data.Map as M

type Cost = Int
type Vertex = Int
type Edge = ((Vertex, Vertex), Cost)

main = do
 [n, m, s, t] <- map (read:: String -> Int) . words <$> getLine
 roads <- map (tuple . map (read:: String -> Int) . words) . lines <$> getContents
 print . length . possible n (s, t) . S.fromList $ zip roads [1,1..]

possible:: Int -> (Vertex, Vertex) -> S.Set Edge -> [Edge]
possible n (s, g) edge = let sDist = dijkstra n s edge
                             gDist = dijkstra n g edge
                             originalTime = sDist ! g
                         in do
                             start <- [1..n - 1]
                             end <- [start + 1..n]
                             guard $ ((start, end), 1) `S.notMember` edge
                             let route1 = sDist ! start + gDist ! end + 1
                                 route2 = sDist ! end + gDist ! start + 1
                             guard $ route1 >= originalTime && route2 >= originalTime
                             return ((start, end), 1)

dijkstra::Int -> Vertex -> S.Set Edge -> UArray Vertex Cost
dijkstra n s edge = let initialArray = runSTUArray $ do
                                                      mArray <- newArray (1, n) maxBound :: ST s (STUArray s Int Int)
                                                      let reachable = S.toList . omit s $ S.filter (\ ((a, b), c) -> a == s || b == s) edge
                                                      forM_ reachable $ uncurry (writeArray mArray)
                                                      return mArray
                        initialSet = S.delete (maxBound::Int, s) . S.fromList . map (\ (a, b) -> (b, a)) $ assocs initialArray
                        initialMap = M.delete s . M.fromList $ assocs initialArray
                    in array (1, n) . M.toList $ recursive s edge initialSet initialMap M.empty

recursive::Vertex -> S.Set Edge -> S.Set (Cost, Vertex) -> M.Map Vertex Cost -> M.Map Vertex Cost -> M.Map Vertex Cost
recursive s edge costSet costMap distMap
 | S.null costSet = M.insert s 0 distMap
 | otherwise = let (minCost, minVertex) = S.findMin costSet
                   newDistMap = M.insert minVertex minCost distMap
                   neighbors = S.toList . omit minVertex $ S.filter (\ ((a, b), c) -> a == minVertex || b == minVertex) edge
                   (newCostSet, newCostMap) = foldl' (\ (cSet, cMap) (a, c) -> case M.lookup a cMap of
                                                                                Just cost -> if minCost + c < cost then update a (minCost + c) cSet cMap else (cSet, cMap)
                                                                                Nothing -> (cSet, cMap))
                                               (S.delete (minCost, minVertex) costSet, M.delete minVertex costMap) neighbors
               in if minCost == (maxBound :: Int) then error "wrong" else recursive s edge newCostSet newCostMap newDistMap

update::Vertex -> Cost -> S.Set (Cost, Vertex) -> M.Map Vertex Cost -> (S.Set (Cost, Vertex), M.Map Vertex Cost)
update a newCost costSet costMap = case M.lookup a costMap of
                                    Just oldCost -> (S.insert (newCost, a) $ S.delete (oldCost, a) costSet, M.update (\_ -> Just newCost) a costMap)
                                    Nothing -> error "key doesn't exist"

omit::Vertex -> S.Set Edge -> S.Set (Vertex, Cost)
omit x = S.map (\ ((a, b), c) -> if a == x then (b, c) else (a, c))

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


How to make a cake you'll never eat.Ingredients.   2 carrots  0 calories  100 g chocolate spread  1 pack of flour  1 egg Method.   Put calories into the mixing bowl.  Take carrots from refrigerator.  Chop carrots.  Take chocolate spread from refrigerator.  Put chocolate spread into the mixing bowl.  Combine pack of flour into the mixing bowl.  Fold chocolate spread into the mixing bowl.  Add chocolate spread into the mixing bowl.  Put pack of flour into the mixing bowl.  Add egg into the mixing bowl.  Fold pack of flour into the mixing bowl.  Chop carrots until choped.  Pour contents of the mixing bowl into the baking dish. Serves 1.

The only line of input contains a sequence of integers a0, a1, ... (1 ≤ a0 ≤ 100, 0 ≤ ai ≤ 1000 for i ≥ 1).

import System.IO
main = do
    s <- getLine
    putStrLn $ show $ sum $ zipWith (*) [1..] $ map read $ tail $ words $ s

main = do getLine >>= print . sum . zipWith (*) [1..] . map read . tail . words

main :: IO ()
main = do
    s <- getLine
    let a = map read $ tail $ words s :: [Integer]
    print $ sum $ map (uncurry (*)) $ zip a [1..]

main :: IO ()
main = do
    s <- getLine
    let a = map read $ tail $ words s :: [Integer]
    print $ sum $ zipWith (*) a [1..]

main :: IO ()
main = do
    s <- getLine
    let a = map read $ tail $ words s :: [Integer]
    print $ sum $ map (\x -> fst x * snd x) $ zip a [1..]

main = do getLine >>= print . sum . map ((^2) . read) . tail . words


There are $$$n$$$ people sitting in a circle, numbered from $$$1$$$ to $$$n$$$ in the order in which they are seated. That is, for all $$$i$$$ from $$$1$$$ to $$$n-1$$$, the people with id $$$i$$$ and $$$i+1$$$ are adjacent. People with id $$$n$$$ and $$$1$$$ are adjacent as well.The person with id $$$1$$$ initially has a ball. He picks a positive integer $$$k$$$ at most $$$n$$$, and passes the ball to his $$$k$$$-th neighbour in the direction of increasing ids, that person passes the ball to his $$$k$$$-th neighbour in the same direction, and so on until the person with the id $$$1$$$ gets the ball back. When he gets it back, people do not pass the ball any more.For instance, if $$$n = 6$$$ and $$$k = 4$$$, the ball is passed in order $$$[1, 5, 3, 1]$$$. Consider the set of all people that touched the ball. The fun value of the game is the sum of the ids of people that touched it. In the above example, the fun value would be $$$1 + 5 + 3 = 9$$$.Find and report the set of possible fun values for all choices of positive integer $$$k$$$. It can be shown that under the constraints of the problem, the ball always gets back to the $$$1$$$-st player after finitely many steps, and there are no more than $$$10^5$$$ possible fun values for given $$$n$$$.

The only line consists of a single integer $$$n$$$ ($$$2 \leq n \leq 10^9$$$) — the number of people playing with the ball.

Suppose the set of all fun values is $$$f_1, f_2, \dots, f_m$$$. Output a single line containing $$$m$$$ space separated integers $$$f_1$$$ through $$$f_m$$$ in increasing order.

NoteIn the first sample, we've already shown that picking $$$k = 4$$$ yields fun value $$$9$$$, as does $$$k = 2$$$. Picking $$$k = 6$$$ results in fun value of $$$1$$$. For $$$k = 3$$$ we get fun value $$$5$$$ and with $$$k = 1$$$ or $$$k = 5$$$ we get $$$21$$$.   In the second sample, the values $$$1$$$, $$$10$$$, $$$28$$$, $$$64$$$ and $$$136$$$ are achieved for instance for $$$k = 16$$$, $$$8$$$, $$$4$$$, $$$10$$$ and $$$11$$$, respectively.

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

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int64
  putStrLn $ unwords $ map show $ map (\d -> d + (n * (d-1)) `shiftR` 1)
    $ divisors n

{-# INLINE divisors #-}
divisors :: (Integral i) => i -> [i]
divisors n = sort $ process 1 $ primeDecp n
  where
    process !x ((p,n):ps) = do
      pk <- take (n+1) $ iterate (p*) 1
      process (x*pk) ps
    process !x [] = return x

{-# INLINE primeDecp #-}
primeDecp :: (Integral i) => i -> [(i,Int)]
primeDecp n = let cons = (:); nil = [] in
  let (expt2,n1) = countExpt n 2
      loop p n rt | n == 1    = nil
                  | p > rt    = cons (n,1) nil
                  | expt > 0  = cons (p,expt) $ loop (p+2) n_ (sqrtInt n_)
                  | otherwise = loop (p+2) n rt
        where
          (expt,n_) = countExpt n p
  in (if expt2 > 0 then cons (2,expt2) else id)
     $ loop 3 n1 (sqrtInt n1)

{-# INLINE countExpt #-}
countExpt :: (Integral i) => i -> i -> (Int, i)
countExpt !x !base
  = (\(Just (!j,!q0,!q1,!r1)) -> (j,q0))
      $ find (\(!j,!q0,!q1,!r1) -> r1 /= 0) divlist
  where
    (!q0,!r0) = x `divMod` base
    divlist = iterate (\(!j,!q0,!q1,!r1) -> let (q2,r2) = q1 `divMod` base
                                            in (j+1,q1,q2,r2))
              (0,x,q0,r0)

{-# INLINE sqrtInt #-}
sqrtInt :: (Integral i) => i -> i
sqrtInt x = ceiling $ sqrt (fromIntegral x :: Double)

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

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray hiding ((!))
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

factor :: Int -> [Int]
factor n = nub $ concatMap (factor' n) [1..m] where
    m = ceiling (sqrt $ fromIntegral n)
    factor' n i = if n `mod` i == 0 then [i, n `div` i] else []

-- Arithmetic sum
sumSeq n d = n * (2 + (n-1) * d) `div` 2

process :: Int -> [Integer]
process n = map (\f -> sumSeq f (n' `div` f)) factors where
    n' = toInteger n
    factors = map toInteger (sort $ factor n)

main = do
    n <- getInt
    putStrLn $ unwords $ map show $ process n

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Map as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Integer] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve n = map toSum $ concat [factors n, factors2 n]
    where cand n = takeWhile (\i -> i * i <= n) [1..]
          factors n = filter (\k -> n `mod` k == 0) $ cand n
          factors2 = map (\v -> n `div` v) . factors
          toSum k = let v = n `div` k in v * (v - 1) `div` 2 * k + v

main = do
    [n] <- getIntegers
    printInts $ nub $ sort $ solve n

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

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  putStrLn $ unwords $ map show $ map (\d -> d + (n * (d-1)) `shiftR` 1)
    $ divisors n

{-# INLINE divisors #-}
divisors :: (Integral i) => i -> [i]
divisors n = sort $ process 1 $ primeDecp n
  where
    process !x ((p,n):ps) = do
      pk <- take (n+1) $ iterate (p*) 1
      process (x*pk) ps
    process !x [] = return x

{-# INLINE primeDecp #-}
primeDecp :: (Integral i) => i -> [(i,Int)]
primeDecp n = let cons = (:); nil = [] in
  let (expt2,n1) = countExpt n 2
      loop p n rt | n == 1    = nil
                  | p > rt    = cons (n,1) nil
                  | expt > 0  = cons (p,expt) $ loop (p+2) n_ (sqrtInt n_)
                  | otherwise = loop (p+2) n rt
        where
          (expt,n_) = countExpt n p
  in (if expt2 > 0 then cons (2,expt2) else id)
     $ loop 3 n1 (sqrtInt n1)

{-# INLINE countExpt #-}
countExpt :: (Integral i) => i -> i -> (Int, i)
countExpt !x !base
  = (\(Just (!j,!q0,!q1,!r1)) -> (j,q0))
      $ find (\(!j,!q0,!q1,!r1) -> r1 /= 0) divlist
  where
    (!q0,!r0) = x `divMod` base
    divlist = iterate (\(!j,!q0,!q1,!r1) -> let (q2,r2) = q1 `divMod` base
                                            in (j+1,q1,q2,r2))
              (0,x,q0,r0)

{-# INLINE sqrtInt #-}
sqrtInt :: (Integral i) => i -> i
sqrtInt x = floor $ sqrt (fromIntegral x :: Double)

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Map as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve n = map toSum $ concat [factors n, factors2 n]
    where cand n = takeWhile (\i -> i * i <= n) [1..]
          factors n = filter (\k -> n `mod` k == 0) $ cand n
          factors2 = map (\v -> n `div` v) . factors
          toSum k = let v = n `div` k in v * (v - 1) `div` 2 * k + v

main = do
    [n] <- getInts
    printInts $ nub $ sort $ solve n


You are given a matrix $$$a$$$ consisting of positive integers. It has $$$n$$$ rows and $$$m$$$ columns.Construct a matrix $$$b$$$ consisting of positive integers. It should have the same size as $$$a$$$, and the following conditions should be met:   $$$1 \le b_{i,j} \le 10^6$$$;  $$$b_{i,j}$$$ is a multiple of $$$a_{i,j}$$$;  the absolute value of the difference between numbers in any adjacent pair of cells (two cells that share the same side) in $$$b$$$ is equal to $$$k^4$$$ for some integer $$$k \ge 1$$$ ($$$k$$$ is not necessarily the same for all pairs, it is own for each pair). We can show that the answer always exists.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n,m \le 500$$$). Each of the following $$$n$$$ lines contains $$$m$$$ integers. The $$$j$$$-th integer in the $$$i$$$-th line is $$$a_{i,j}$$$ ($$$1 \le a_{i,j} \le 16$$$).

The output should contain $$$n$$$ lines each containing $$$m$$$ integers. The $$$j$$$-th integer in the $$$i$$$-th line should be $$$b_{i,j}$$$.

NoteIn the first example, the matrix $$$a$$$ can be used as the matrix $$$b$$$, because the absolute value of the difference between numbers in any adjacent pair of cells is $$$1 = 1^4$$$.In the third example:   $$$327$$$ is a multiple of $$$3$$$, $$$583$$$ is a multiple of $$$11$$$, $$$408$$$ is a multiple of $$$12$$$, $$$664$$$ is a multiple of $$$8$$$;  $$$|408 - 327| = 3^4$$$, $$$|583 - 327| = 4^4$$$, $$$|664 - 408| = 4^4$$$, $$$|664 - 583| = 3^4$$$.

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

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

type SIO = StateT P.ByteString IO

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, _m] <- readInts
  a <- replicateM n $ readInts
  let
    base = foldr1 lcm [1..16] -- strictly between 16^4 and 10^6, OK
    colors = cycle [cycle [0,1], cycle [1,0]]
    ans = zipWith (zipWith (\aij color -> base - color * aij^4)) a colors
  forM_ ans putInts

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

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

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


A permutation of length $$$n$$$ is an array $$$p=[p_1,p_2,\dots,p_n]$$$, which contains every integer from $$$1$$$ to $$$n$$$ (inclusive) and, moreover, each number appears exactly once. For example, $$$p=[3,1,4,2,5]$$$ is a permutation of length $$$5$$$.For a given number $$$n$$$ ($$$n \ge 2$$$), find a permutation $$$p$$$ in which absolute difference (that is, the absolute value of difference) of any two neighboring (adjacent) elements is between $$$2$$$ and $$$4$$$, inclusive. Formally, find such permutation $$$p$$$ that $$$2 \le |p_i - p_{i+1}| \le 4$$$ for each $$$i$$$ ($$$1 \le i < n$$$).Print any such permutation for the given integer $$$n$$$ or determine that it does not exist.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases in the input. Then $$$t$$$ test cases follow. Each test case is described by a single line containing an integer $$$n$$$ ($$$2 \le n \le 1000$$$).

Print $$$t$$$ lines. Print a permutation that meets the given requirements. If there are several such permutations, then print any of them. If no such permutation exists, print -1.

import           Control.Arrow

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

solve :: Int -> [Int]
solve 1 = [1]
solve n | n <= 3 = [-1]
solve n = [1, 3 .. n-4] ++ four [n-3 .. n] ++ reverse [2, 4 .. n-4]
  where
    four [a,b,c,d] = [b,d,a,c]

import Control.Monad

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

routine :: IO ()
routine = do
  n <- readLn
  putStrLn $ (unwords.map show) $ solve n

solve :: Int -> [Int]
solve n
  | n<4 = [-1]
  | otherwise = reverse (take l1 [1,3..]) ++ take l2 (4:2:[6,8..])
  where
    l1 = if even n
      then n `div` 2
      else (n+1) `div` 2
    l2 = n `div` 2

solve :: [Int] -> [Int]
solve [a1,a2,a3,a4,a5] = [a1,a3,a5,a2,a4]
solve [a1,a2,a3,a4,a5,a6] = [a1,a4,a2,a5,a3,a6]
solve [a1,a2,a3,a4,a5,a6,a7] = [a1,a5,a2,a6,a3,a7,a4]
solve (a1:a2:a3:a4:as) = a2:a4:a1:a3: solve as
solve _ = []

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:_) <- readNums
    case solve [1..n] of
        [] -> putStrLn "-1"
        ans -> putStrLn $ unwords $ map show ans
    testCases (t-1)

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

readNums :: (Read n) => IO [n]
readNums = map read . words <$> getLine

solve :: [Int] -> [Int]
solve [a1,a2,a3,a4,a5] = [a1,a3,a5,a3,a4]
solve [a1,a2,a3,a4,a5,a6] = [a1,a4,a2,a5,a3,a6]
solve [a1,a2,a3,a4,a5,a6,a7] = [a1,a5,a2,a6,a3,a7,a4]
solve (a1:a2:a3:a4:as) = a2:a4:a1:a3: solve as
solve _ = []

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:_) <- readNums
    case solve [1..n] of
        [] -> putStrLn "-1"
        ans -> putStrLn $ unwords $ map show ans
    testCases (t-1)

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

readNums :: (Read n) => IO [n]
readNums = map read . words <$> getLine


You are given a n × m field consisting only of periods ('.') and asterisks ('*'). Your task is to count all right triangles with two sides parallel to the square sides, whose vertices are in the centers of '*'-cells. A right triangle is a triangle in which one angle is a right angle (that is, a 90 degree angle).

The first line contains two positive integer numbers n and m (1 ≤ n, m ≤ 1000). The following n lines consist of m characters each, describing the field. Only '.' and '*' are allowed.

Output a single number — total number of square triangles in the field. Please, do not use %lld specificator to read or write 64-bit integers in C++. It is preffered to use cout (also you may use %I64d).

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

main = do
	[n, m] <- fmap (map read . words) getLine
	a <- replicateM n getLine
	putStrLn $ show $ gao n m a

gao n m a = sum [row!i * col!j | i <- [1 .. n], j <- [1 .. m], mat!(i,j) == '*'] where
	cnt l = listArray (1, length l) $ map (toInteger . pred . length . filter (=='*')) $ l
	row = cnt a
	col = cnt $ transpose a
	mat = listArray ((1,1), (n,m)) $ concat a

import Control.Monad
import Data.Array
import Data.Int
import Data.List

main = do
	[n, m] <- fmap (map read . words) getLine
	a <- replicateM n getLine
	putStrLn $ (show::Int64->String) $ gao n m a

gao n m a = sum [row!i * col!j | i <- [1 .. n], j <- [1 .. m], mat!(i,j) == '*'] where
	cnt l = listArray (1, length l) $ map (fromIntegral . pred . length . filter (=='*')) $ l
	row = cnt a
	col = cnt $ transpose a
	mat = listArray ((1,1), (n,m)) $ concat a

module Main where

import Control.Monad
import Data.List

main = do
    [h, w] <- ( map read . words ) `liftM` getLine
    board <- replicateM h getLine
    --let (h, w) = (1000, 1000)
        --board = replicate h ( replicate w '*' )
    let rowCount = map (fromIntegral . length . filter (=='*')) board
        colCount = foldl' (\colCount row -> zipWith (\c ch -> if ch == '*' then c+1 else c) colCount row) (replicate w 0) board
        rowRes = zipWith (\row rowCount ->
                ( foldl' (\acc (ch, colCount) -> acc +
                        if ch == '*'
                        then (colCount-1) * (rowCount-1)
                        else 0
                    ) 0 (zip row colCount) )
            ) board rowCount
        res = sum rowRes

    --putStrLn $ show rowCount
    --putStrLn $ show colCount
    --putStrLn $ show rowRes
    putStrLn $ show res

import Data.Array
import Data.List

main=interact $ show . f . lines
f (nm:field) = sum [ (table1!i - 1) * (table2!j - 1) |
  (i, line) <- zip [1..] field, (j, '*') <- zip [1..] line ]
  where
  [n,m] = map read $ words nm
  table1 = listArray (1, n) [ sum [ 1 | '*' <- line ] | line <- field ]
  table2 = listArray (1, m) [ sum [ 1 | '*' <- line ] | line <- transpose field ]

module Main where

import Control.Monad
import Data.List
import Data.Array
import Data.Int
import Debug.Trace

readI :: String -> Int
readI = read

readL :: String -> [Int]
readL = (map read) . words

main = do
    [n, m] <- getLine >>= return . readL
    ss <- getContents >>= return . (take n) . lines
    print $ solve n m ss

solve n m ss = parser ss where
    ms = listArray (0, m-1) $ map count (transpose ss)
    mj j = fromIntegral (ms!j - 1)

    parser ss = parser' ss 0 where

        parser' :: [String] -> Int64 -> Int64
        parser' []     acc = acc
        parser' (s:ss) acc = if n > 0
            then parser' ss (acc + n*(sum $ map mj $ findIndices (=='*') s))
            else parser' ss acc
            where n = fromIntegral (count s - 1)

count s = length $ filter (=='*') s

import Data.List
import Data.Int

solve arr = sum $ zipWith (*) row $ map (sum . zipWith (\x y -> if y=='*' then x else 0) col) arr
  where
    mapping :: [[Char]] -> [Int64]
    mapping = map ((\x -> fromIntegral x - 1) . length . filter (=='*'))
    row = mapping arr
    col = mapping $ transpose arr

main = do
    arr <- fmap (tail.lines) getContents
    print $ solve arr

{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Int

solve arr = sum $ zipWith (*) row $ map (sum . zipWith (\x y -> if y=='*' then x else 0) col) arr
  where
    mapping = map ((\x -> fromIntegral x - 1) . length . filter (=='*'))
    row = mapping arr :: [Int64]
    col = mapping $ transpose arr

main = do
    arr <- fmap (tail . lines) getContents
    print $ solve arr

module Main where

import Control.Monad
import Data.List

main = do
    --[h, w] <- ( map read . words ) `liftM` getLine
    --board <- replicateM h getLine
    let (h, w) = (1000, 1000)
        board = replicate h ( replicate w '*' )
    let rowCount = map (fromIntegral . length . filter (=='*')) board
        colCount = foldl' (\colCount row -> zipWith (\c ch -> if ch == '*' then c+1 else c) colCount row) (replicate w 0) board
        rowRes = zipWith (\row rowCount ->
                ( foldl' (\acc (ch, colCount) -> acc +
                        if ch == '*'
                        then (colCount-1) * (rowCount-1)
                        else 0
                    ) 0 (zip row colCount) )
            ) board rowCount
        res = sum rowRes

    --putStrLn $ show rowCount
    --putStrLn $ show colCount
    --putStrLn $ show rowRes
    putStrLn $ show res

import Data.Array
import Data.List

main=interact $ show . f . lines
f (nm:field) = sum [ (table1!i - 1) * (table2!j - 1) |
  (i, line) <- zip [1..] field, (j, '*') <- zip [1..] line ]
  where
  [n,m] = map read $ words nm
  table1 = listArray (1, n) $ map (length . filter (=='*')) field
  table2 = listArray (1, m) $ map (length . filter (=='*')) $ transpose field

module Main where

import Control.Monad
import Data.List
import Data.Array
import Debug.Trace

readI :: String -> Int
readI = read

readL :: String -> [Int]
readL = (map read) . words

main = do
    [n, m] <- getLine >>= return . readL
    ss <- getContents >>= return . (take n) . lines
    print $ solve n m ss

solve n m ss = parser ss where
    ms = listArray (0, m-1) $ map count (transpose ss)
    mj j = (ms!j) - 1

    parser ss = parser' ss 0 where

        parser' []     acc = acc
        parser' (s:ss) acc = if n > 1
            then parser' ss (acc + (n-1)*(sum $ map mj $ findIndices (=='*') s))
            else parser' ss acc
            where n = count s

count s = length $ filter (=='*') s


Anna is a girl so brave that she is loved by everyone in the city and citizens love her cookies. She is planning to hold a party with cookies. Now she has $$$a$$$ vanilla cookies and $$$b$$$ chocolate cookies for the party.She invited $$$n$$$ guests of the first type and $$$m$$$ guests of the second type to the party. They will come to the party in some order. After coming to the party, each guest will choose the type of cookie (vanilla or chocolate) to eat. There is a difference in the way how they choose that type:If there are $$$v$$$ vanilla cookies and $$$c$$$ chocolate cookies at the moment, when the guest comes, then  if the guest of the first type: if $$$v>c$$$ the guest selects a vanilla cookie. Otherwise, the guest selects a chocolate cookie.  if the guest of the second type: if $$$v>c$$$ the guest selects a chocolate cookie. Otherwise, the guest selects a vanilla cookie. After that:  If there is at least one cookie of the selected type, the guest eats one.  Otherwise (there are no cookies of the selected type), the guest gets angry and returns to home. Anna wants to know if there exists some order of guests, such that no one guest gets angry. Your task is to answer her question.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Next $$$t$$$ lines contain descriptions of test cases. For each test case, the only line contains four integers $$$a$$$, $$$b$$$, $$$n$$$, $$$m$$$ ($$$0 \le a,b,n,m \le 10^{18}, n+m \neq 0$$$).

For each test case, print the answer in one line. If there exists at least one valid order, print "Yes". Otherwise, print "No". You can print each letter in any case (upper or lower).

NoteIn the first test case, let's consider the order $$$\{1, 2, 2\}$$$ of types of guests. Then:  The first guest eats a chocolate cookie. After that, there are $$$2$$$ vanilla cookies and $$$1$$$ chocolate cookie.  The second guest eats a chocolate cookie. After that, there are $$$2$$$ vanilla cookies and $$$0$$$ chocolate cookies.  The last guest selects a chocolate cookie, but there are no chocolate cookies. So, the guest gets angry. So, this order can't be chosen by Anna.Let's consider the order $$$\{2, 2, 1\}$$$ of types of guests. Then:  The first guest eats a vanilla cookie. After that, there is $$$1$$$ vanilla cookie and $$$2$$$ chocolate cookies.  The second guest eats a vanilla cookie. After that, there are $$$0$$$ vanilla cookies and $$$2$$$ chocolate cookies.  The last guest eats a chocolate cookie. After that, there are $$$0$$$ vanilla cookies and $$$1$$$ chocolate cookie. So, the answer to this test case is "Yes".In the fifth test case, it is illustrated, that the number of cookies ($$$a + b$$$) can be equal to zero, but the number of guests ($$$n + m$$$) can't be equal to zero.In the sixth test case, be careful about the overflow of $$$32$$$-bit integer type.

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

main = getLine >>= flip replicateM_ test . read

test = do
  [a, b, n, m] <- map read . words <$> getLine
  putStrLn $ bool "No" "Yes" $ a + b >= n + m && min a b >= m

import           Control.Monad

main :: IO()
main =
  do
    x <- read <$> getLine
    replicateM_ x solve

solve :: IO()
solve =
  do
    [a, b, n, m] <- map read . words <$> getLine :: IO [Integer]
    let c = min a b
    if c >= m && a + b >= n + m
      then
        putStrLn "Yes"
      else
        putStrLn "No"

import           Control.Monad

main :: IO()
main =
  do
    x <- read <$> getLine
    replicateM_ x solve

solve :: IO()
solve =
  do
    [a, b, n, m] <- map read . words <$> getLine :: IO [Integer]
    let c = min a b
    if c >= m && a + b >= n + m
      then
        print "Yes"
      else
        print "No"


Three swimmers decided to organize a party in the swimming pool! At noon, they started to swim from the left side of the pool.It takes the first swimmer exactly $$$a$$$ minutes to swim across the entire pool and come back, exactly $$$b$$$ minutes for the second swimmer and $$$c$$$ minutes for the third. Hence, the first swimmer will be on the left side of the pool after $$$0$$$, $$$a$$$, $$$2a$$$, $$$3a$$$, ... minutes after the start time, the second one will be at $$$0$$$, $$$b$$$, $$$2b$$$, $$$3b$$$, ... minutes, and the third one will be on the left side of the pool after $$$0$$$, $$$c$$$, $$$2c$$$, $$$3c$$$, ... minutes.You came to the left side of the pool exactly $$$p$$$ minutes after they started swimming. Determine how long you have to wait before one of the swimmers arrives at the left side of the pool.

The first line of the input contains a single integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. Next $$$t$$$ lines contains test case descriptions, one per line. Each line contains four integers $$$p$$$, $$$a$$$, $$$b$$$ and $$$c$$$ ($$$1 \leq p, a, b, c \leq 10^{18}$$$), time in minutes after the start, when you came to the pool and times in minutes it take the swimmers to cross the entire pool and come back.

For each test case, output one integer — how long you have to wait (in minutes) before one of the swimmers arrives at the left side of the pool.

NoteIn the first test case, the first swimmer is on the left side in $$$0, 5, 10, 15, \ldots$$$ minutes after the start time, the second swimmer is on the left side in $$$0, 4, 8, 12, \ldots$$$ minutes after the start time, and the third swimmer is on the left side in $$$0, 8, 16, 24, \ldots$$$ minutes after the start time. You arrived at the pool in $$$9$$$ minutes after the start time and in a minute you will meet the first swimmer on the left side.In the second test case, the first swimmer is on the left side in $$$0, 6, 12, 18, \ldots$$$ minutes after the start time, the second swimmer is on the left side in $$$0, 10, 20, 30, \ldots$$$ minutes after the start time, and the third swimmer is on the left side in $$$0, 9, 18, 27, \ldots$$$ minutes after the start time. You arrived at the pool $$$2$$$ minutes after the start time and after $$$4$$$ minutes meet the first swimmer on the left side.In the third test case, you came to the pool $$$10$$$ minutes after the start time. At the same time, all three swimmers are on the left side. A rare stroke of luck!In the fourth test case, all swimmers are located on the left side in $$$0, 9, 18, 27, \ldots$$$ minutes after the start time. You arrived at the pool $$$10$$$ minutes after the start time and after $$$8$$$ minutes meet all three swimmers on the left side.

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

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

import Data.Int

ceilDiv :: Integral t => t -> t -> t
ceilDiv n k = div (n + k - 1) k

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [p, a, b, c] <- readInts
    let  tar = minimum [xi * ceilDiv p xi | xi <- [a, b, c]]
    -- ??? How is this wrong?
    putInt64s [tar - p]

type SIO = StateT P.ByteString IO

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

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

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

-- import Debug.Trace

type InType  = (Integer, Integer, Integer, Integer)
type OutType = Integer

inpLines :: Int
inpLines = 1

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

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

solve :: InType -> OutType
solve (p,a,b,c) = minimum [go a, go b, go c]
    where go x = if p `mod` x == 0
                 then 0
                 else x - (p `mod` x)

receive :: [String] -> InType
receive [s] = (p,a,b,c)
    where [p,a,b,c] = toArr s

main :: IO ()
main = interact (unlines . map (show . solve . receive) . chunksOf inpLines . tail . lines)

import Control.Monad

main = nCases $ do
  [p, a, b, c] <- line
  print $ min (next p a) (min (next p b) $ next p c) - p

next p n = n * (p `updiv` n)
updiv a b = (a + b - 1) `div` b
line = fmap read . words <$> getLine
nCases a = readLn >>= flip replicateM_ a

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

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

------

type Hopper r = State [r]

type HopperT r = StateT [r]

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

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

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

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

type MonadHopper r m = MonadState [r] m

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

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

------

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

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

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

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

------

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

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

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

------

run :: Hopper B.ByteString B.ByteString
run = do
  t <- popInt
  B.unlines <$> replicateM t run1

run1 = do
  ~[p, a, b, c] <- popIntegers
  return $ bshow (solve p a b c)

solve p a b c = minimum $ map f [a, b, c]
  where
    f x = case p `quotRem` x of
            (_, 0) -> 0
            (q, _) -> (q + 1) * x - p

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

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

import Data.Int

ceilDiv :: Integral t => t -> t -> t
ceilDiv n k = div (n + k - 1) k

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [p, a, b, c] <- readInts
    let  tar = minimum [xi * ceilDiv p xi | xi <- [a, b, c]]
    putInt64s [tar - p]

type SIO = StateT P.ByteString IO

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

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

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

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

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

ceilDiv :: Integral t => t -> t -> t
ceilDiv n k = div (n + k - 1) k

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [p, a, b, c] <- readInts
    let  tar = minimum [xi * ceilDiv p xi | xi <- [a, b, c]]
    putInts [tar - p]

type SIO = StateT P.ByteString IO

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

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

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

-- import Debug.Trace

type InType  = (Int, Int, Int, Int)
type OutType = Int

inpLines :: Int
inpLines = 1

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

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

solve :: InType -> OutType
solve (p,a,b,c) = minimum [go a, go b, go c]
    where go x = if p `mod` x == 0
                 then 0
                 else x - (p `mod` x)

receive :: [String] -> InType
receive [s] = (p,a,b,c)
    where [p,a,b,c] = toArr s

main :: IO ()
main = interact (unlines . map (show . solve . receive) . chunksOf inpLines . tail . lines)


British mathematician John Littlewood once said about Indian mathematician Srinivasa Ramanujan that "every positive integer was one of his personal friends."It turns out that positive integers can also be friends with each other! You are given an array $$$a$$$ of distinct positive integers. Define a subarray $$$a_i, a_{i+1}, \ldots, a_j$$$ to be a friend group if and only if there exists an integer $$$m \ge 2$$$ such that $$$a_i \bmod m = a_{i+1} \bmod m = \ldots = a_j \bmod m$$$, where $$$x \bmod y$$$ denotes the remainder when $$$x$$$ is divided by $$$y$$$.Your friend Gregor wants to know the size of the largest friend group in $$$a$$$.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 2\cdot 10^4$$$).  Each test case begins with a line containing the integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$), the size of the array $$$a$$$. The next line contains $$$n$$$ positive integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le {10}^{18}$$$), representing the contents of the array $$$a$$$. It is guaranteed that all the numbers in $$$a$$$ are distinct. It is guaranteed that the sum of $$$n$$$ over all test cases is less than $$$2\cdot 10^5$$$.

Your output should consist of $$$t$$$ lines. Each line should consist of a single integer, the size of the largest friend group in $$$a$$$.

NoteIn the first test case, the array is $$$[1,5,2,4,6]$$$. The largest friend group is $$$[2,4,6]$$$, since all those numbers are congruent to $$$0$$$ modulo $$$2$$$, so $$$m=2$$$.In the second test case, the array is $$$[8,2,5,10]$$$. The largest friend group is $$$[8,2,5]$$$, since all those numbers are congruent to $$$2$$$ modulo $$$3$$$, so $$$m=3$$$.In the third case, the largest friend group is $$$[1000,2000]$$$. There are clearly many possible values of $$$m$$$ that work.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}

import Control.Applicative (liftA2)
import Control.Monad (foldM_, forM_, replicateM, guard)
import Control.Monad.ST
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.Array as A
import Data.Array.Base ((!))
import Data.Array.ST
import qualified Data.Array.Unboxed as U
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Int
import Data.Maybe (fromJust)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = show . solve <$> numberOf (fromIntegral <$> integer)

type ArrayI64 = U.UArray Int Int64
type ArrayInt = U.UArray Int Int

lg = 20
lim = 2 * 10^5 + 5
logs :: ArrayInt
logs = U.array (1, lim) $ do
  l <- [0 .. lg]
  i <- [2 ^ l .. 2 ^ (l + 1) - 1]
  guard $ i <= lim
  return (i, l)

solve :: [Int64] -> Int
solve [_] = 1
solve xs = (1 +) . maximum $ map computeAt [0 .. n - 1]
  where
    n = length xs - 1

    computeAt i = min (i + 1) . foldl pick 0 $ reverse [0 .. lg - 1]
      where
        pick len j =
          let l = max 0 $ i - len - 2 ^ j + 1
              g = rangeGCD l i
           in len + (if g == 1 then 0 else 2 ^ j)

    -- adjacent differences
    diffs :: ArrayI64
    diffs = U.listArray (0, n - 1) $ map abs $ zipWith (-) xs (tail xs)

    -- rangeGCD l r = gcd a[l..r]
    --(j, l') = maximum [(j, l') | j <- [0..lg], let l' = l + 2^j - 1, l' <= r]
    rangeGCD :: Int -> Int -> Int64
    rangeGCD l r =
      let j = logs ! (r - l + 1)
          l' = l + 2 ^ j - 1
       in gcd (sparseGCD ! r ! j) (sparseGCD ! l' ! j)

    -- sparseGCD ! i ! j = gcd a[i - 2^j + 1 .. i]
    sparseGCD :: A.Array Int ArrayI64
    sparseGCD = runST $ do
      let nil = U.listArray (0, lg - 1) $ replicate lg 0
      gcds <- newArray (0, n - 1) nil :: ST s (STArray s Int ArrayI64)

      forM_ [0 .. n - 1] $ \i -> do
        cur <- thaw nil :: ST s (STUArray s Int Int64)
        writeArray cur 0 (diffs ! i)
        forM_ [1 .. lg - 1] $ \j -> do
          a <- readArray cur (j - 1)
          bs <- readArray gcds $ max 0 (i - 2 ^ (j - 1))
          let b = bs ! (j - 1)
          writeArray cur j $ gcd a b
        freeze cur >>= writeArray gcds i

      freeze gcds

foldM_' b ta f = foldM_ f b ta

-------------------------- Template ------------------------------------------

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

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

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

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

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

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

(><) = times

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

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

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

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

import Data.Int
import Data.Char
import Data.Array.Unboxed
import Data.Bits

type Sparse = Array Int (UArray Int Int64)

bitFloor :: Int -> Int
bitFloor x
  = 1 `shift` (finiteBitSize (undefined :: Int) - countLeadingZeros x - 1)

query :: Sparse -> Int -> Int -> Int64
query st i j = let
  w = j - i
  sw = bitFloor w
  layer = countTrailingZeros sw
  in  gcd (st ! layer ! i) (st ! layer ! (j  - sw))

tstep :: UArray Int Int64 -> Int -> UArray Int Int64
tstep arr ss = let
  (p, q) = bounds arr
  in  array (p, q - ss) $ do
  i <- [p .. q - ss]
  pure $ (i, gcd (arr ! i) (arr ! (i + ss)))

mkSparse :: UArray Int Int64 -> Sparse
mkSparse arr = let
  (p, q) = bounds arr
  lastLayer = countTrailingZeros $ bitFloor $ q + 1 - p
  vs = iterate (* 2) 1
  in  listArray (0, lastLayer) $ scanl tstep arr $ take lastLayer vs

parseN :: Num t => P.ByteString -> t
parseN = let
  step x c = x * 10 + fromIntegral (ord c - ord '0')
  in  P.foldl' step 0

readNs :: Num t => SIO [t]
readNs = map parseN . P.words <$> readLine

binS :: (Int -> Bool) -> Int -> Int -> Int
binS fun x y = if  x == y
  then  x
  else  let
  z = div (x + y + 1) 2
  in  if  fun z
  then  binS fun x (z-1)
  else  binS fun z y

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    aLi <- readNs :: SIO [Int64]
    let
      v = listArray (1, n-1) $ zipWith (\x y -> abs (x - y)) aLi (tail aLi)
      tv = mkSparse v
      ans = foldl' max 1 $ do
        i <- [1 .. n-1]
        let  stop = binS (\j -> query tv i j == 1) i n
        pure $ stop - i + 1
    putInts [ans]

type SIO = StateT P.ByteString IO

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

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

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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Applicative (liftA2)
import Control.Monad (forM_, replicateM)
import Control.Monad.ST
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.Array as A
import Data.Array.Base ((!))
import Data.Array.ST
import qualified Data.Array.Unboxed as U
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Int
import Data.Maybe (fromJust)
import Debug.Trace (trace)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = show . solve <$> numberOf (fromIntegral <$> integer)

type ArrayI64 = U.UArray Int Int64

solve :: [Int64] -> Int
solve [_] = 1
solve xs = (1+) . maximum $ debug $ map computeAt [0 .. n -1]
  where
    n = length xs - 1
    lg = 3

    computeAt i = min (i + 1) . foldl pick 0 $ reverse [0 .. lg - 1]
      where
        pick len j =
          let l = max 0 $ i - len - 2^j + 1
              g = rangeGCD l i
           in len + (if g == 1 then 0 else 2^j)

    -- adjacent differences
    diffs :: ArrayI64
    diffs = debug $ U.listArray (0, n - 1) $ map abs $ zipWith (-) xs (tail xs)

    -- rangeGCD l r = gcd a[l..r]
    rangeGCD :: Int -> Int -> Int64
    rangeGCD l r =
      let (j, l') = maximum [(j, l') | j <- [0..lg], let l' = l + 2^j - 1, l' <= r]
       in gcd (sparseGCD ! r ! j) (sparseGCD ! l' ! j)

    -- sparseGCD ! i ! j = gcd a[i - 2^j + 1 .. i]
    sparseGCD :: A.Array Int ArrayI64
    sparseGCD = debug $ runST $ do
      let nil = U.listArray (0, lg - 1) $ replicate lg 0
      gcds <- newArray (0, n - 1) nil :: ST s (STArray s Int ArrayI64)

      forM_ [0 .. n - 1] $ \i -> do
        cur <- thaw nil :: ST s (STUArray s Int Int64)
        writeArray cur 0 (diffs ! i)
        forM_ [1 .. lg - 1] $ \j -> do
          a <- readArray cur (j - 1)
          bs <- readArray gcds $ max 0 (i - 2 ^ (j - 1))
          let b = bs ! (j - 1)
          writeArray cur j $ gcd a b
        freeze cur >>= writeArray gcds i

      freeze gcds

-------------------------- Template ------------------------------------------
-- debug a = trace (show a) a
debug a = a

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

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

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

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

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

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

(><) = times

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

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


The city Valera lives in is going to hold elections to the city Parliament.The city has n districts and n - 1 bidirectional roads. We know that from any district there is a path along the roads to any other district. Let's enumerate all districts in some way by integers from 1 to n, inclusive. Furthermore, for each road the residents decided if it is the problem road or not. A problem road is a road that needs to be repaired.There are n candidates running the elections. Let's enumerate all candidates in some way by integers from 1 to n, inclusive. If the candidate number i will be elected in the city Parliament, he will perform exactly one promise — to repair all problem roads on the way from the i-th district to the district 1, where the city Parliament is located.Help Valera and determine the subset of candidates such that if all candidates from the subset will be elected to the city Parliament, all problem roads in the city will be repaired. If there are several such subsets, you should choose the subset consisting of the minimum number of candidates.

The first line contains a single integer n (2 ≤ n ≤ 105) — the number of districts in the city. Then n - 1 lines follow. Each line contains the description of a city road as three positive integers xi, yi, ti (1 ≤ xi, yi ≤ n, 1 ≤ ti ≤ 2) — the districts connected by the i-th bidirectional road and the road type. If ti equals to one, then the i-th road isn't the problem road; if ti equals to two, then the i-th road is the problem road. It's guaranteed that the graph structure of the city is a tree.

In the first line print a single non-negative number k — the minimum size of the required subset of candidates. Then on the second line print k space-separated integers a1, a2, ... ak — the numbers of the candidates that form the required subset. If there are multiple solutions, you are allowed to print any of them.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    n <- readLn
    s <- B.getContents
    let g [x,y,t] = let b = t == 1 in [(x,(y,b)),(y,(x,b))]
    let l = concat $ map (g . map readInt . B.words) $ B.lines s
    let ans = solve n l
    print (length ans)
    putStrLn $ unwords $ map show ans

solve n es = go (-1) 1 []
    where
    graph :: Array Int [(Int,Bool)]
    graph = accumArray (\e a -> a:e) [] (1,n) es
    go !prev !v !acc = sub (graph ! v) acc
        where
        sub [] !acc = acc
        sub ((w,b):next) !acc
            | w == prev = sub next acc
            | b = sub next (go v w acc)
            | otherwise =  sub next acc1
                where
                acc1 = case go v w acc of
                    [] -> w:acc
                    acc' | not (null acc) && head acc == head acc' -> w:acc
                         | otherwise -> acc'

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    n <- readLn
    s <- B.getContents
    let g [x,y,t] = let b = t == 1 in [(x,(y,b)),(y,(x,b))]
    let l = concat $ map (g . map readInt . B.words) $ B.lines s
    let ans = solve n l
    print (length ans)
    putStrLn $ unwords $ map show ans

solve n es = go (-1) 1 []
    where
    graph :: Array Int [(Int,Bool)]
    graph = accumArray (\e a -> a:e) [] (1,n) es
    go !prev !v !acc = sub (graph ! v) acc
        where
        sub [] !acc = acc
        sub ((w,b):next) !acc
            | w == prev = sub next acc
            | b = sub next (go v w acc)
            | otherwise =  sub next acc1
                where
                acc1 = case go v w acc of
                        [] -> w:acc
                        acc' | null acc || head acc == head acc' -> w:acc
                             | otherwise -> acc'


Andrew and Eugene are playing a game. Initially, Andrew has string s, consisting of digits. Eugene sends Andrew multiple queries of type "di → ti", that means "replace all digits di in string s with substrings equal to ti". For example, if s = 123123, then query "2 → 00" transforms s to 10031003, and query "3 → " ("replace 3 by an empty string") transforms it to s = 1212. After all the queries Eugene asks Andrew to find the remainder after division of number with decimal representation equal to s by 1000000007 (109 + 7). When you represent s as a decimal number, please ignore the leading zeroes; also if s is an empty string, then it's assumed that the number equals to zero.Andrew got tired of processing Eugene's requests manually and he asked you to write a program for that. Help him!

The first line contains string s (1 ≤ |s| ≤ 105), consisting of digits — the string before processing all the requests. The second line contains a single integer n (0 ≤ n ≤ 105) — the number of queries. The next n lines contain the descriptions of the queries. The i-th query is described by string "di->ti", where di is exactly one digit (from 0 to 9), ti is a string consisting of digits (ti can be an empty string). The sum of lengths of ti for all queries doesn't exceed 105. The queries are written in the order in which they need to be performed.

Print a single integer — remainder of division of the resulting number by 1000000007 (109 + 7).

NoteNote that the leading zeroes are not removed from string s after the replacement (you can see it in the third sample).

import qualified Data.Array as Array
import Data.Array (Array)
import Data.Char
import Data.Int

newtype Mod = Mod Int64

instance Num Mod where
  Mod x + Mod y = Mod ((x + y) `mod` 1000000007)
  Mod x * Mod y = Mod ((x * y) `mod` 1000000007)
  fromInteger n = Mod $ fromInteger (n `mod` 1000000007)
  negate x = error "foo"
  signum x = error "foo"

instance Show Mod where
  show (Mod x) = show x

type Query = (Int, [Int])
newtype Len = Len { unLen :: Mod }
type Outcome = (Len, Mod)

step :: Query -> Array Int Outcome -> Array Int Outcome
step (x, s) arr =

  let oldLen i = fst (arr Array.! i) in
  let oldMod i = snd (arr Array.! i) in

  Array.listArray (0, 9)
  [
    if x == i then
      foldl
      (\(Len len, m) d -> (Len $ len * unLen (oldLen d), m * (unLen (oldLen d)) + oldMod d))
      (Len 1,0) s
    else arr Array.! i
  | i<-[0..9]]

solve :: ([Query], [Int]) -> Outcome
solve (queries, s) = go ((0, s) : queries) Array.! 0 where
  go = foldr step (Array.listArray (0,9) [(Len 10,fromInteger i)|i<-[0..9]])

parseQuery (d : '-' : '>' : s) = (digitToInt d, map digitToInt s)

parse (s : _ : ss) =
  (map parseQuery ss, map digitToInt s)

main = interact $ show . snd . solve . parse . lines

import qualified Data.Array as Array
import Data.Array (Array)
import Data.Char

newtype Mod = Mod Int

instance Num Mod where
  Mod x + Mod y = Mod ((x + y) `mod` 1000000007)
  Mod x * Mod y = Mod ((x * y) `mod` 1000000007)
  fromInteger n = Mod $ fromInteger (n `mod` 1000000007)
  negate x = error "foo"
  signum x = error "foo"

instance Show Mod where
  show (Mod x) = show x

type Query = (Int, [Int])
newtype Len = Len { unLen :: Mod }
type Outcome = (Len, Mod)

step :: Query -> Array Int Outcome -> Array Int Outcome
step (x, s) arr =

  let oldLen i = fst (arr Array.! i) in
  let oldMod i = snd (arr Array.! i) in

  Array.listArray (0, 9)
  [
    if x == i then
      foldl
      (\(Len len, m) d -> (Len $ len * unLen (oldLen d), m * (unLen (oldLen d)) + oldMod d))
      (Len 1,0) s
    else arr Array.! i
  | i<-[0..9]]

solve :: ([Query], [Int]) -> Outcome
solve (queries, s) = go ((0, s) : queries) Array.! 0 where
  go = foldr step (Array.listArray (0,9) [(Len 10,fromInteger i)|i<-[0..9]])

parseQuery (d : '-' : '>' : s) = (digitToInt d, map digitToInt s)

parse (s : _ : ss) =
  (map parseQuery ss, map digitToInt s)

main = interact $ show . snd . solve . parse . lines