如何在 Haskell 中實現 Dijkstra 算法

Question

為了我的學習，我必須編寫以下函數來獲得兩個國家之間的最短路線。 我已經寫了一個函數 isRoute 來檢查兩個國家之間是否有連接，還有一個函數 yieldRoute 只返回兩個國家之間的連接。 現在我必須編寫一個函數來返回兩個國家之間的最短路線。

我的第一種方法是獲取兩國之間的所有連接，然后獲取最短的連接，但在我看來，獲取所有連接對編程來說有點煩人。 現在我想出了實現 dijstra 算法的想法，但實際上我也覺得這有點難。 你們能給我一些想法如何做到這一點嗎？

我們必須使用這些類型（我們不允許更改它們，但我們可以添加新類型。）

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

這個我現在必須寫：

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

Dijkstra 算法： 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

我基本上想知道在 Haskell 中實現 Dijkstra 的最佳方法是什么，或者是否有另一種方法可以遵循。

Answer 1

Andrew Goldberg和Simon Peyton Jones對這一主題進行了精彩而精彩的介紹： http ： //www.ukuug.org/events/agm2010/ShortestPath.pdf

在編寫任何代碼之前，它幫助我理解了這個問題。 它很好地解釋了Dijkstra的算法，之后您會發現它很容易實現。 它還對原始算法進行了各種改進，這很可能會激發你的靈感。

Answer 2

你似乎已經編碼了算法的很大一部分

這是 Martin Erwig 在 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

其余模塊在這里

Answer 3

編輯：以下實際上不是 Dijkstra。 該算法稱為SPFA。

要實現該算法，您應該考慮所需的最少信息量，使用它來構建通用解決方案，然后將解決方案應用於您的特定案例。

在 Dijkstra 的情況下，它關心：

• 識別節點
• 比較路徑成本
• 確定從節點到哪里。

我們可以這樣編碼

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)

現在，您可以自由地以任何方式表示您的圖形，並將成本視為您想要的任何東西。

這是一個使用 Map 來表示字符的小圖形的示例。

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
            ]

如果您不僅想知道從 A 到 B 的成本，還想知道完整路徑，您可以將此信息與您的成本一起存儲。

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
            ]