Как реализовать алгоритм Дейкстры в Haskell

для учебы я должен написать следующую функцию, которая получает кратчайший маршрут между двумя странами. Я уже написал функцию isRoute, которая проверяет, есть ли связь между двумя странами, и функцию yieldRoute, которая просто возвращает связь между двумя странами. Теперь мне нужно закодировать функцию, которая возвращает кратчайший маршрут между двумя странами.

мой первый подход, чтобы получить все связи между двумя странами, а затем получить самый короткий, но получение всех соединений, на мой взгляд, раздражает программу. Теперь я придумал идею реализовать алгоритм dijstra, но на самом деле мне это тоже сложно. Ребята, вы можете мне подсказать, как это сделать?

мы должны использовать эти типы (нам не разрешено изменять их, но ofc нам разрешено добавлять новые типы.)

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)

моя функция маршрута выхода которая просто поиск ширины первый: (Sry для немецкого комментарии)

-- 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

Это я должен написать сейчас:

yieldFastestRoute :: Connections -> Country -> Country -> Itinerary
Дейкстра : http://en.wikipedia.org/wiki/Dijkstra%27s_algorithm

мой первый подход был таков: (как я сказал, У меня были проблемы с 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

Я в основном хочу знать, что лучший способ реализовать Dijkstra в Haskell, или если есть другой подход, я мог бы следовать.

2 ответов


существует замечательный и блестящий введение в эту тему по Эндрю Голдберг и Саймон Пейтон Джонс:http://www.ukuug.org/events/agm2010/ShortestPath.pdf

это помогло мне понять проблему, прежде чем писать какой-либо код вообще. Он очень хорошо объясняет алгоритм Дейкстры, после чего его будет легко реализовать. Он также дает всевозможные улучшения в оригинальном алгоритме, который, скорее всего, вдохновит вас так же, как он вдохновил мне.


вы, кажется, закодировали большую часть алгоритма

вот проект Мартина Эрвига в Haskell, который может помочь дать вам некоторые идеи

--  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

остальное модули здесь