結果

問題 No.17 2つの地点に泊まりたい
ユーザー aimyaimy
提出日時 2017-07-20 17:09:02
言語 Haskell
(9.8.2)
結果
CE  
(最新)
AC  
(最初)
実行時間 -
コード長 1,804 bytes
コンパイル時間 99 ms
コンパイル使用メモリ 150,784 KB
最終ジャッジ日時 2024-04-27 02:28:04
合計ジャッジ時間 376 ms
ジャッジサーバーID
（参考情報） 		judge3 / judge4
このコードへのチャレンジ
（要ログイン）
コンパイルエラー時のメッセージ・ソースコードは、提出者また管理者しか表示できないようにしております。（リジャッジ後のコンパイルエラーは公開されます）
ただし、clay言語の場合は開発者のデバッグのため、公開されます。

コンパイルメッセージ
Loaded package environment from /home/judge/.ghc/x86_64-linux-9.8.2/environments/default
[1 of 2] Compiling Main             ( Main.hs, Main.o )

Main.hs:2:1: error: [GHC-87110]
    Could not load module ‘Data.Map’.
    It is a member of the hidden package ‘containers-0.6.8’.
    Use -v to see a list of the files searched for.
  |
2 | import qualified Data.Map as M
  | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

ソースコード

diff # 

import Control.Monad
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as B
import Data.Maybe

type Vertex = Int
type Weight = Int
type Edge = ((Vertex, Vertex), (Weight, Path))
type Path = [Vertex]
type Memo = M.Map (Vertex, Vertex) (Weight, Path)

readUndirectedEdge :: B.ByteString -> [Edge]
readUndirectedEdge = concatMap (constructEdge . map readInt . B.words) . B.lines

constructEdge :: [Int] -> [Edge]
constructEdge [s,t,w] = [((s,t), (w,[s,t])), ((t,s), (w,[t,s]))]
constructEdge _ = undefined

readInt :: B.ByteString -> Int
readInt = fst . fromJust . B.readInt

main :: IO ()
main = do
  n <- readLn
  ss <- replicateM n readLn
  _ <- getLine
  es <- readUndirectedEdge <$> B.getContents
  print (stay2 n ss es)

stay2 :: Int -> [Int] -> [Edge] -> Int
stay2 n ss = minimum . pay n ss . warshallFloyd n

pay :: Int -> [Int] -> Memo -> [Int]
pay n ss m = do
  s1 <- [1..n-2]
  s2 <- [1..n-2]
  guard (s1 /= s2)
  return (cost m 0 s1 + cost m s1 s2 + cost m s2 (n-1) + ss!!s1 + ss!!s2)

cost :: Memo -> Vertex -> Vertex -> Weight
cost m s t = fst $ M.findWithDefault (100000,[]) (s,t) m 

warshallFloyd :: Int -> [Edge] -> Memo
warshallFloyd n es = foldl shorten m0 kij
  where
    m0 = M.fromList es
    kij = [(k,i,j) | k<-[0..n-1], i<-[0..n-1], j<-[0..n-1]]

shorten :: Memo -> (Vertex, Vertex, Vertex) -> Memo
shorten m (k,i,j) = case connect m k i j of
  Nothing -> m
  Just (w,p) -> M.insertWith lexmin (i,j) (w,p) m

connect :: Memo -> Vertex -> Vertex -> Vertex -> Maybe (Weight, Path)
connect m k i j = do
  (w1,p1) <- M.lookup (i,k) m
  (w2,p2) <- M.lookup (k,j) m
  return (w1 + w2, init p1 ++ tail p2)

lexmin :: (Weight, Path) -> (Weight, Path) -> (Weight, Path)
lexmin (w1,p1) (w2,p2)
  | w1 < w2 = (w1, p1)
  | w1 == w2 = (w1, min p1 p2)
  | otherwise = (w2,p2)
0