Dijkstra まだ一度も走らせていない。

たぶんバグあり。

module Dijkstra where
import Data.List
import Data.Graph
import Data.Array.IArray
import Debug.Trace
import qualified Data.Set as Set

type Weight = Array Edge Int

-- g=graph, w=weight, d=distance, p=path, q=queue
dijkstra :: Graph -> Weight -> Set.Set (Int,Vertex) -> Array Vertex (Int,Vertex) -> Set.Set Vertex -> Array Vertex (Int,Vertex)
dijkstra g w d p q
| Set.null q = p
| otherwise = let ((_,u),d') = Set.deleteFindMin d
(d'',p',q') = update g w d' p q u
in dijkstra g w d'' p' q'
update g w d p q u
| Set.member u q = (d',p',q')
| otherwise = (d,p,q)
where q' = Set.delete u q
vs = intersect (Set.toList q') \$reachable g u
du = fst.(p!)\$u
updates = [(du+w!(u,v),v)|v<-vs,du + w!(u,v) < (fst.(p!))v]
d' = foldl (flip Set.insert) d updates

shortestPath ::Graph -> Weight -> Vertex -> Array Vertex (Int,Vertex)
shortestPath g w s = dijkstra g w d p q
where maxW = sum.elems\$w
d = Set.fromList\$(0,s):[(maxW,v)|v<-vertices g,v/=s]
p = array (bounds g)\$(s,(0,s)):[(v,(maxW,s))|v<-vertices g,v/=s]
q = Set.fromList.vertices\$g

それにしても、あまり美しくない。しかもヒープを使っていないという罠。

だって、ヒープのパッケージ入ってないし。

もしかしたらqは不要？

qは不要でした。

module Dijkstra where
import Data.List
import Data.Graph
import Data.Array.Diff
import Control.Arrow
import qualified Data.Set as S

type Weight = Array Edge Int

-- g=graph, w=weight, d=distance, p=path
dijkstra :: Graph -> Weight -> (S.Set (Int,Vertex) ,Table (Int,Vertex)) -> Table (Int,Vertex)
dijkstra g w = snd.until (S.null.fst) (update g w)
update g w (d,p) | du > (fst.(p!))u = (d',p)
| otherwise = (d'',p')
where ((du,u),d') = S.deleteFindMin d
updates = [(du+w!(u,v),v)|v<-g!u,du + w!(u,v) < (fst.(p!))v]
d'' = foldl (flip S.insert) d' updates

shortestPaths ::Graph -> Weight -> Vertex -> Table (Int,Vertex)
shortestPaths g w s = dijkstra g w (d,p)
where maxW = (1+).sum.map (w!).edges\$g
d = S.fromList\$(0,s):[(maxW,v)|v<-vertices g,v/=s]
p = array (bounds g)\$(s,(0,s)):[(v,(maxW,s))|v<-vertices g,v/=s]

shortestPath ::Graph -> Weight -> Vertex ->Vertex-> (Int,[Vertex])
shortestPath g w s = (fst.(p!)&&&(s:).reverse.unfoldr f)
where p = shortestPaths g w s
f v | s==v = Nothing
| v/=s = Just (v,snd.(p!)\$v)

だけどまだ、ヒープを使ってなし、プライオリティキューも使ってない。

しかし、log N は定数という説があるから、まあ良い？