Submission #286722

---

Source Code Expand

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE NPlusKPatterns      #-}
{-# LANGUAGE ScopedTypeVariables #-}
import           Control.Applicative         hiding (empty)
import           Control.Arrow
import           Control.Monad
import           Data.Array
import           Data.Bits
import           Control.Monad.State
import           Control.Monad.Trans.List
import qualified Data.ByteString.Char8       as B
import qualified Data.List                   as L
import           Data.Ord
import qualified Data.Set                    as S
import           Data.STRef
import qualified Data.Vector                 as V
import qualified Data.Vector.Mutable         as MV
import qualified Data.Vector.Unboxed         as UV
import qualified Data.Vector.Unboxed.Mutable as UMV
import           Debug.Trace

main = do
  n <- readInt <$> B.getLine
  k <- readInt <$> B.getLine
  putStrLn $ if n >= k + k then "YES" else "NO"

initGraph :: Int -> [[Int]] -> V.Vector [(Vertex, Int)]
initGraph n rs = V.create $ do
  es <- MV.new n
  forM_ [0..n-1] $ \i -> MV.write es i []
  forM_ rs $ \[a, b, c] -> do
    MV.read es a >>= MV.write es a . ((b, c):)
    MV.read es b >>= MV.write es b . ((a, c):)
  return es

bfs :: Monad m => (a -> m [a]) -> [a] -> m [a]
bfs f xs = liftM concat (mapM f xs) >>= liftM (xs++) . bfs f

type Vertex = Int
dijkstra :: Int -> Int -> V.Vector [(Vertex, Int)] -> UV.Vector Int
dijkstra n s es = UV.create $ do
  let inf = 2 ^ 28 :: Int
  ds <- UMV.new n
  forM_ [0..n-1] $ \i -> UMV.write ds i inf
  UMV.write ds s 0
  queue <- newSTRef $ insert (0, s) empty
  let
    loop =
      minView <$> readSTRef queue >>= \x -> case x of
        Nothing -> return ()
        Just ((d, v), r) -> do
          writeSTRef queue r
          d' <- UMV.read ds v
          when (d <= d') $
            forM_ (V.unsafeIndex es v) $ \(u, w) -> do
              d'' <- UMV.read ds u
              when (d + w < d'') $ do
                UMV.write ds u (d + w)
                modifySTRef queue (insert (d + w, u))
          loop
  loop
  return ds

readInt bs = let Just (v, _) = B.readInt bs in v
readInts = map readInt . B.words

data PairingHeap a = Empty | PairingHeap !a ![PairingHeap a]
  deriving (Eq, Show)

empty :: PairingHeap a
empty = Empty

insert :: Ord a => a -> PairingHeap a -> PairingHeap a
insert a = merge (PairingHeap a [])

minView :: Ord a => PairingHeap a -> Maybe (a, PairingHeap a)
minView Empty = Nothing
minView (PairingHeap a s) = Just (a, mergePairs s)

merge :: Ord a => PairingHeap a -> PairingHeap a -> PairingHeap a
merge h1@(PairingHeap a1 c1) h2@(PairingHeap a2 c2)
  | a1 < a2   = PairingHeap a1 (h2:c1)
  | otherwise = PairingHeap a2 (h1:c2)
merge Empty h2 = h2
merge h1 Empty = h1

mergePairs :: Ord a => [PairingHeap a] -> PairingHeap a
mergePairs [] = Empty
mergePairs [h] = h
mergePairs (h1:h2:rest) = merge (merge h1 h2) $ mergePairs rest

Submission Info

Judge Result