Dijkstra's algorithm: Difference between revisions

=={{header|Haskell}}==

{{trans|C++}}

Translation of the C++ solution, and all the complexities are the same as in the C++ solution. In particular, we again use a self-balancing binary search tree (<code>Data.Set</code>) to implement the priority queue, which results in an optimal complexity.

<lang haskell>import Data.Array

import Data.Array.MArray

import Data.Array.ST

import Control.Monad.ST

import Control.Monad (foldM)

import Data.Set as S

dijkstra :: (Ix v, Num w, Ord w, Bounded w) => v -> v -> Array v [(v,w)] -> (Array v w, Array v v)

dijkstra src invalid_index adj_list = runST $ do

min_distance <- newSTArray b maxBound

writeArray min_distance src 0

previous <- newSTArray b invalid_index

let aux vertex_queue =

case S.minView vertex_queue of

Nothing -> return ()

Just ((dist, u), vertex_queue') ->

let edges = adj_list ! u

f vertex_queue (v, weight) = do

let dist_thru_u = dist + weight

old_dist <- readArray min_distance v

if dist_thru_u >= old_dist then

return vertex_queue

else do

let vertex_queue' = S.delete (old_dist, v) vertex_queue

writeArray min_distance v dist_thru_u

writeArray previous v u

return $ S.insert (dist_thru_u, v) vertex_queue'

in

foldM f vertex_queue' edges >>= aux

aux (S.singleton (0, src))

m <- freeze min_distance

p <- freeze previous

return (m, p)

where b = bounds adj_list

newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)

newSTArray = newArray

shortest_path_to :: (Ix v) => v -> v -> Array v v -> [v]

shortest_path_to target invalid_index previous =

aux target [] where

aux vertex acc | vertex == invalid_index = acc

| otherwise = aux (previous ! vertex) (vertex : acc)

adj_list :: Array Int [(Int, Int)]

adj_list = listArray (0, 5) [ [(1,7), (2,9), (5,14)],

[(0,7), (2,10), (3,15)],

[(0,9), (1,10), (3,11), (5,2)],

[(1,15), (2,11), (4,6)],

[(3,6), (5,9)],

[(0,14), (2,2), (4,9)] ]

main :: IO ()

main = do

let (min_distance, previous) = dijkstra 0 (-1) adj_list

putStrLn $ "Distance from 0 to 4: " ++ show (min_distance ! 4)

let path = shortest_path_to 4 (-1) previous

putStrLn $ "Path: " ++ show path</lang>