How to implement Dijkstra Algorithm in Haskell

Question

For my studies I have to write the following function which gets the shortest route between two countries. I already have already written a function isRoute which checks if there is a connection between two countries, and a function yieldRoute which just returns a connection between two countries. Now I have to code a function which returns the shortest route between two countries.

My first approach was to get all connections between the two countries and then get the shortest one, but getting all connections is kind of annoying to programm in my opinion. Now I come up with the idea to implement a dijstra algorithm, but I actually find this kinda hard too. Can you guys give me some idea how to do this?

We have to use these types (we aren't allowed to change them but ofc we are allowed to add new types.)

type Country = String
type Countries = [Country]
type TravelTime = Integer -- Travel time in minutes
data Connection = Air Country Country TravelTime
    | Sea Country Country TravelTime
    | Rail Country Country TravelTime
    | Road Country Country TravelTime deriving (Eq,Ord,Show)
type Connections = [Connection]
data Itinerary = NoRoute | Route (Connections,TravelTime) deriving (Eq,Ord,Show)

My yield route function which is simply breadth first search: (Sry for german comments)

-- Liefert eine Route falls es eine gibt
yieldRoute :: Connections -> Country -> Country -> Connections
yieldRoute cons start goal 
            | isRoute cons start goal == False = []
            | otherwise                        = getRoute cons start [] [start] goal

getRoute :: Connections -> Country -> Connections -> Countries -> Country -> Connections
getRoute cons c gone visited target
            | (c == target) = gone 
            | otherwise  = if ( visit cons c visited ) then ( getRoute cons (deeper cons c visited) (gone ++ get_conn cons c (deeper cons c visited)) (visited ++ [(deeper cons c visited)]) target ) else ( getRoute cons (back (drop (length gone -1) gone)) (take (length gone -1) gone) visited target )

-- Geht ein Land zurück
back :: Connections -> Country
back ((Air c1 c2 _):xs) = c1
back ((Sea c1 c2 _):xs) = c1
back ((Rail c1 c2 _):xs) = c1
back ((Road c1 c2 _):xs) = c1

-- Liefert das nächste erreichbare Country
deeper :: Connections -> Country -> Countries -> Country
deeper ((Air c1 c2 _):xs) c visited
            | (c1 == c) = if ( c2 `elem` visited ) then ( deeper xs c visited ) else c2
            | (c2 == c) = if ( c1 `elem` visited ) then ( deeper xs c visited ) else c1
            | otherwise = deeper xs c visited
deeper ((Sea c1 c2 _):xs) c visited
            | (c1 == c) = if ( c2 `elem` visited ) then ( deeper xs c visited ) else c2
            | (c2 == c) = if ( c1 `elem` visited ) then ( deeper xs c visited ) else c1
            | otherwise = deeper xs c visited
deeper ((Rail c1 c2 _):xs) c visited
            | (c1 == c) = if ( c2 `elem` visited ) then ( deeper xs c visited ) else c2
            | (c2 == c) = if ( c1 `elem` visited ) then ( deeper xs c visited ) else c1
            | otherwise = deeper xs c visited
deeper ((Road c1 c2 _):xs) c visited
            | (c1 == c) = if ( c2 `elem` visited ) then ( deeper xs c visited ) else c2
            | (c2 == c) = if ( c1 `elem` visited ) then ( deeper xs c visited ) else c1
            | otherwise = deeper xs c visited

-- Liefert eine Connection zwischen zwei Countries
get_conn :: Connections -> Country -> Country -> Connections
get_conn [] _ _ = error "Something went terribly wrong"
get_conn ((Air c1 c2 t):xs) c3 c4 
            | (c1 == c3) && (c2 == c4) = [(Air c1 c2 t)]
            | (c1 == c4) && (c2 == c3) = [(Air c1 c2 t)]
            | otherwise                = get_conn xs c3 c4
get_conn ((Sea c1 c2 t):xs) c3 c4 
            | (c1 == c3) && (c2 == c4) = [(Air c1 c2 t)]
            | (c1 == c4) && (c2 == c3) = [(Air c1 c2 t)]
            | otherwise                = get_conn xs c3 c4
get_conn ((Road c1 c2 t):xs) c3 c4 
            | (c1 == c3) && (c2 == c4) = [(Air c1 c2 t)]
            | (c1 == c4) && (c2 == c3) = [(Air c1 c2 t)]
            | otherwise                = get_conn xs c3 c4
get_conn ((Rail c1 c2 t):xs) c3 c4 
            | (c1 == c3) && (c2 == c4) = [(Air c1 c2 t)]
            | (c1 == c4) && (c2 == c3) = [(Air c1 c2 t)]
            | otherwise                = get_conn xs c3 c4

-- Überprüft ob eine besuchbare Connection exestiert
visit :: Connections -> Country -> Countries -> Bool
visit [] _ _ = False
visit ((Air c1 c2 _):xs) c visited
                | (c1 == c) = if ( c2 `elem` visited) then ( visit xs c visited ) else True
                | (c2 == c) = if ( c1 `elem` visited) then ( visit xs c visited ) else True
                | otherwise = visit xs c visited
visit ((Sea c1 c2 _):xs) c visited
                | (c1 == c) = if ( c2 `elem` visited) then ( visit xs c visited ) else True
                | (c2 == c) = if ( c1 `elem` visited) then ( visit xs c visited ) else True
                | otherwise = visit xs c visited
visit ((Rail c1 c2 _):xs) c visited
                | (c1 == c) = if ( c2 `elem` visited) then ( visit xs c visited ) else True
                | (c2 == c) = if ( c1 `elem` visited) then ( visit xs c visited ) else True
                | otherwise = visit xs c visited
visit ((Road c1 c2 _):xs) c visited
                | (c1 == c) = if ( c2 `elem` visited) then ( visit xs c visited ) else True
                | (c2 == c) = if ( c1 `elem` visited) then ( visit xs c visited ) else True

This one i have to write now:

yieldFastestRoute :: Connections -> Country -> Country -> Itinerary

Dijkstra Algorithm: http://en.wikipedia.org/wiki/Dijkstra%27s_algorithm

My first approach was this: (as I said I had problems with the getallRoutes)

yieldFastestRoute :: Connections -> Country -> Country -> Itinerary
yieldFastestRoute cons start targ
            |(isRoute start targ == False) = NoRoute
            |otherwise                    = (Route (getFastest (getAllRoutes cons start targ)) (sumTT (getFastest (getAllRoutes cons start targ))))

-- Liefert alle Routen zwischen zwei Ländern
getAllRoutes :: Connections -> Country -> Country -> [Connections]

-- Liefert aus einer Reihe von Connections die schnellste zurück
getFastest :: [Connections] -> Connections
getFastest (x:xs) = if ( (sumTT x) < sumTT (getFastest xs) || null (getFastest xs) ) then x else ( getFastest xs )

sumTT :: Connections -> TravelTime
sumTT []                  = 0
sumTT ((Air _ _ t ): xs)  = t ++ sumTT xs
sumTT ((Rail _ _ t ): xs) = t ++ sumTT xs
sumTT ((Road _ _ t ): xs) = t ++ sumTT xs
sumTT ((Sea _ _ t ): xs)  = t ++ sumTT xs

I basically want to know whats the best way to implement Dijkstra in Haskell, or if there's another approach I could follow.

Bluster

1. What is the Dijkstra algorithm? 2. Show us your attempt at implementing it. 3. Clarify what part of implementing it you are finding difficult. – Spokane

I want to if theres a not extremly difficult way to implement dijstra in haskell or if there are some easier approches to solve the problem: en.wikipedia.org/wiki/Dijkstra%27s_algorithm – Bluster

I think this question would be better answerable if you focused on asking how to create the appropriate graph data structures. after that, implementing Dijkstra shouldn't be hard. Also you have a ton of code and that is a little bit hard to swallow, specially with the german comments – Hanyang

The Code of the yieldroute function basicly isnt important to read. Only the one with the types is, so its shouldn`t be that hard to read i guess. Yeah basicly i dont know how to approch the Dijkstra thing. I guess i have to make a graph? I mean i know how Dijkstra wordks, but i dont get how i could implement it in Haskell. This is where i need the help – Bluster

There is a wonderful and brilliant introduction to this topic by Andrew Goldberg and Simon Peyton Jones: ukuug.org/events/agm2010/ShortestPath.pdf It has helped me to understand the problem, before writing any code at all. It explains Dijkstra's algorithm very well, after which you will find it easy to implement. It also gives all sorts of improvements on the original algorithm, which will most likely inspire you as much as it inspired me. – Starkey

The link is dead web.archive.org/web/20221006203138if_/https://www.ukuug.org/… – Soyuz

Answer 1

You seem to have coded great part of the Algorithm

Here is a project by Martin Erwig in Haskell that may help to give you some ideas

--  SP.hs -- Dijkstra's Shortest Path Algorithm  (c) 2000 by Martin Erwig
module SP (
   spTree,spLength,sp,      -- shortest paths
   dijkstra
) where

import qualified Heap as H
import Graph
import RootPath
expand :: Real b => b -> LPath b -> Context a b -> [H.Heap (LPath b)]
expand d p (_,_,_,s) = map (\(l,v)->H.unit ((v,l+d):p)) s
dijkstra :: Real b => H.Heap (LPath b) -> Graph a b -> LRTree b
dijkstra h g | H.isEmpty h || isEmpty g = []
dijkstra h g =
    case match v g of
         (Just c,g')  -> p:dijkstra (H.mergeAll (h':expand d p c)) g'
         (Nothing,g') -> dijkstra h' g'  
    where (p@((v,d):_),h') = H.splitMin h

spTree :: Real b => Node -> Graph a b -> LRTree b
spTree v = dijkstra (H.unit [(v,0)])
spLength :: Real b => Node -> Node -> Graph a b -> b
spLength s t = getDistance t . spTree s
sp :: Real b => Node -> Node -> Graph a b -> Path
sp s t = map fst . getLPath t . spTree s

The rest modules are here

Pecos

The link at the end of the answer seems broken. – Lignite

Answer 2

EDIT: The following is in fact not Dijkstra. This algorithm is known as SPFA.

To implement the algorithm you should think of the minimum amount of information you need, use that to build a general solution, and then apply the solution to your particular case.

In the case of Dijkstra it cares about:

• Identifying a node
• Comparing path costs
• Identifying where to go from a node.

We can code that as such

import qualified Data.Set as Set

dijkstra
    :: (Ord cost , Ord node)
    => ((cost , node) -> [(cost , node)]) -- ^ Where we can go from a node and the cost of that
    -> node                               -- ^ Where we want to get to
    -> (cost , node)                      -- ^ The start position
    -> Maybe (cost , node)                -- ^ Maybe the answer. Maybe it doesn't exist
dijkstra next target start = search mempty (Set.singleton start)
    where
        search visited toBeVisited = case Set.minView toBeVisited of
            Nothing -> Nothing
            Just ((cost , vertex) , withoutVertex)
                | vertex == target            -> Just (cost , vertex)
                | vertex `Set.member` visited -> search visited withoutVertex
                | otherwise                   -> search visitedWithNode withNext
                where
                    visitedWithNode = Set.insert vertex visited
                    withNext = foldr Set.insert withoutVertex $ next (cost , vertex)

Now you have freedom to represent your graph however you want, and to treat your cost as whatever you want.

Here is an example using a Map to represent a small graph of characters.

import Data.Maybe (fromMaybe)
import qualified Data.Map.Strict as Map

graph =
    Map.fromList
        [ ('a' , [(1 , 'b') , (5 , 'c')])
        , ('b' , [(2 , 'c')])
        , ('c' , [(1 , 'a') , (5 , 'b')])
        ]

-- Output:
-- Just (3,'c')
main = print $ dijkstra step 'c' (0 , 'a')
    where
        step :: (Int , Char) -> [(Int , Char)]
        step (cost , node) =
            [ (cost + edgeCost , child)
            | (edgeCost , child) <- fromMaybe [] $ Map.lookup node graph
            ]

If you want to know not only the cost of getting from A to B, but also the full path, you could just store this information together with your cost.

data Path a = Path {cost :: Int , trajectory :: [a]}
    deriving (Show)

instance Eq (Path a) where
    a == b = cost a == cost b

instance Ord (Path a) where
    compare a b = compare (cost a) (cost b)


-- Output:
--     Just (Path {cost = 3, trajectory = "cba"},'c')
tryItOutWithPath = dijkstra step 'c' (Path 0 ['a'] , 'a')
    where
        step :: (Path Char , Char) -> [(Path Char , Char)]
        step (Path cost traj , node) =
            [ (Path (cost + edgeCost) (child : traj) , child)
            | (edgeCost , child) <- fromMaybe [] $ Map.lookup node graph
            ]

Unpractical

This is in fact not Dijkstra. This algorithm is known as SPFA: en.wikipedia.org/wiki/Shortest_Path_Faster_Algorithm – Unmitigated

@Unmitigated I disagree, it is in fact Dijkstra: toBeVisited is a priority queue because it contains pairs of (distance, vertex). The algorithm always processes the nearest vertex first (Dijkstra) and never needs to lower a computed distance once a vertex has been added to visited, as Bellman-Ford or SPFA do. – Soyuz