Skip to content

Instantly share code, notes, and snippets.

@csoroz

csoroz/Dijkstra.hs

Created May 17, 2019 14:52
Show Gist options
  • Save csoroz/e54b1c44539c39e03ce937e46ff0d28d to your computer and use it in GitHub Desktop.
Save csoroz/e54b1c44539c39e03ce937e46ff0d28d to your computer and use it in GitHub Desktop.
Download ZIP
Dijkstra's shortest path algorithm for monoids types with infinity
Raw
Dijkstra.hs
import Data.List
import qualified Data.List.Key as K
import Data.Map ((!), fromList, fromListWith, adjust, keys, Map)
import Data.Monoid.Inf (Inf(..),Pos,posInfty) -- cabal install monoid-extras
type T = Inf Pos Integer
type G a = Map a [(a,T)]
buildGraph :: Ord a => [(a,a,T)] -> G a
buildGraph g = fromListWith (++) (g >>= f) where
f (a,b,d) = [(a,[(b,d)]), (b,[(a,d)])]
dijkstra :: Ord a => a -> G a -> Map a (T, Maybe a)
dijkstra source graph =
f (fromList [(v, (if v == source then Finite 0 else posInfty, Nothing))
| v <- keys graph]) (keys graph) where
f ds [] = ds
f ds q = f (foldr relax ds $ graph!m) (delete m q) where
m = K.minimum (fst . (ds!)) q
relax (e,d) = adjust (min (fst (ds!m) <> d, Just m)) e
shortestPath :: Ord a => a -> a -> G a -> [a]
shortestPath from to graph = reverse (f to) where
f x = x : maybe [] f (snd $ dijkstra from graph ! x)
main :: IO ()
main = do let g = buildGraph $ map (\(a,b,x) -> (a,b,Finite x))
[('a','c',2), ('a','d',6), ('b','a',3)
,('b','d',8), ('c','d',7), ('c','e',5)
,('d','e',10)]
print $ shortestPath 'a' 'e' g == "ace"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment