Submission #140394

---

Source Code Expand

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString.Char8 as B
import Data.Array.Base
import Data.Array.ST (runSTUArray)
import Data.List
import Data.STRef
import Data.Function
import GHC.Arr (range, Array)

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

#if __GLASGOW_HASKELL__ < 706
modifySTRef' :: STRef s a -> (a -> a) -> ST s ()
modifySTRef' r f=do x<-readSTRef r;writeSTRef r$!f x
{-# INLINE modifySTRef' #-}
#endif

rep :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
{-# INLINE rep #-}

main :: IO ()
main = do
  [n1,m1] <- map read.words <$> getLine
  es <- map readInt.B.words <$> B.getContents
  let (es1,n2:m2:es2) = splitAt (m1*2) es
      gr1 = mkGraph (0,n1-1) $ toEdges es1
      gr2 = mkGraph (0,n2-1) $ toEdges es2
      (r1, d1) = solve gr1
      (r2, d2) = solve gr2
  putStrLn . unwords $ map show [maximum[d1,d2,r1+r2+1], d1+d2+1]

solve :: Graph -> (Int, Int)
solve gr = (minimum eccs, maximum eccs)
   where
     !eccs = map (eccentricity gr) $ vertices gr

type Vertex = Int
type Edge = (Vertex, Vertex)
type Graph = Array Vertex (UArray Int Vertex)

toEdges :: [Vertex] -> [Edge]
toEdges (from:to:vs) = (from,to):(to,from):toEdges vs
toEdges _ = []

mkGraph :: (Int, Int) -> [Edge] -> Graph
mkGraph bnd edges = amap toArray gr
   where
     toArray xs = case listArray (0,length xs-1) xs of arr -> arr
     gr :: Array Vertex [Vertex]
     !gr = unsafeAccumArray (flip (:)) [] bnd edges

vertices :: Graph -> [Vertex]
vertices gr = range (bounds gr)

forEachVertexM_ :: (Monad m) => UArray Int Vertex -> (Vertex -> m ()) -> m ()
forEachVertexM_ nexts@(UArray _ _ size _) act = do
  rep size $ act . unsafeAt nexts
{-# INLINE forEachVertexM_ #-}    

eccentricity :: Graph -> Vertex -> Int
eccentricity gr v = foldl'(flip $ max.unsafeAt dist) 0 $ vertices gr
   where
     !dist = bfs gr v

inf :: Int
inf = 0x3f3f3f3f

data Queue s = Q (STRef s [Vertex]) (STRef s [Vertex])

mkQueue :: ST s (Queue s)
mkQueue = Q <$> newSTRef [] <*> newSTRef []

dequeue :: Queue s -> ST s (Maybe Int)
dequeue (Q front rear) = do
  fs <- readSTRef front
  case fs of
    (f:fs') -> writeSTRef front fs' >> return (Just f)
    [] -> do
      rs <- readSTRef rear
      writeSTRef rear []
      case reverse rs of
        (r:rs') -> writeSTRef front rs' >> return (Just r)
        [] -> return Nothing
{-# INLINE dequeue #-}      

enqueue :: Int -> Queue s -> ST s ()
enqueue x (Q _ rear) = modifySTRef' rear (x:)
{-# INLINE enqueue #-}

bfs :: Graph -> Vertex -> UArray Vertex Int
bfs gr start = runSTUArray $ do
  dist <- newArray (bounds gr) inf :: ST s (STUArray s Vertex Int)
  que <- mkQueue
  
  unsafeWrite dist start 0
  enqueue start que
  
  fix $ \loop -> do
    res <- dequeue que
    case res of
      Just v -> do
        dnv <- (1+) <$> unsafeRead dist v
        forEachVertexM_ (unsafeAt gr v) $ \nv -> do
          old <- unsafeRead dist nv
          when (dnv < old) $ do
            unsafeWrite dist nv dnv
            enqueue nv que
        loop
      Nothing -> return ()

  return dist

Submission Info

Judge Result