Submission #1636132

---

Source Code Expand

import Control.Applicative
import Control.Monad
import Debug.Trace
import Data.Array.IO
import Data.IORef

-- two stack queue
-- ref: Chris Okasaki "Purely Functional Data Structures" p.42
data Queue a = Node [a] [a] deriving (Show)

queueEmpty = Node [] []

queueNull (Node [] []) = True
queueNull (Node _ _) = False

enqueue x (Node s1 s2) = Node s1 (x : s2)

dequeue (Node [] s2) = dequeue (Node (reverse s2) [])
dequeue (Node (s:s1) s2) = (s, Node s1 s2)

main :: IO ()
main = do
  [n1, m1] <- map read . words <$> getLine
  e1 <- map (map read . words) <$> replicateM m1 getLine :: IO [[Int]]
  [n2, m2] <- map read . words <$> getLine
  e2 <- map (map read . words) <$> replicateM m2 getLine :: IO [[Int]]
  (mn1, mx1) <- solve n1 e1
  (mn2, mx2) <- solve n2 e2
  let mn = maximum [mn1 + mn2 + 1, mx1, mx2]
  let mx = mx1 + mx2 + 1
  putStrLn $ show mn ++ " " ++ show mx

solve :: Int -> [[Int]] -> IO (Int, Int)
solve n es = do
  g <- newArray (0, n - 1) [] :: IO (IOArray Int [Int])
  forM_ es $ \[u, v] -> do
    readArray g u >>= writeArray g u . (v:)
    readArray g v >>= writeArray g v . (u:)
  vals <- mapM (minmax n g) [0..n-1]
  let mn = minimum vals
  let mx = maximum vals
  return (mn, mx)

minmax :: Int -> IOArray Int [Int] -> Int -> IO Int
minmax n g u = do
  dist <- newArray (0, n - 1) (-1) :: IO (IOArray Int Int)
  writeArray dist u 0
  let q = enqueue u queueEmpty
  d <- bfs dist g q
  dd <- getElems d
  return $ maximum dd

bfs :: IOArray Int Int -> IOArray Int [Int] -> Queue Int -> IO (IOArray Int Int)
bfs dist g (Node [] []) = return dist
bfs dist g q1 = do
  let (u, q2) = dequeue q1
  q <- newIORef q2
  d <- readArray dist u
  es <- readArray g u
  forM_ es $ \v -> do
    dv <- readArray dist v
    when (dv == (-1)) $ do
      writeArray dist v (d + 1)
      modifyIORef q (enqueue v)

  bfs dist g =<< readIORef q

Submission Info

Judge Result