{- |
Module      :  ./Common/GraphAlgo.hs
Description :  Algorithms on Graphs
Copyright   :  (c) Jonathan von Schroeder, DFKI Bremen 2012
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Jonathan von Schroeder <jonathan.von_schroeder@dfki.de>
Stability   :  provisional
Portability :  portable

-}

module Common.GraphAlgo where

import qualified Data.Map as Map
import Data.Maybe (mapMaybe)

data Graph node edge = Graph {
 Graph node edge -> node -> [(edge, node)]
neighbours :: node -> [(edge, node)],
 Graph node edge -> edge -> Int
weight :: edge -> Int
}

data Node = Node String deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, Eq Node
Eq Node =>
(Node -> Node -> Ordering)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Bool)
-> (Node -> Node -> Node)
-> (Node -> Node -> Node)
-> Ord Node
Node -> Node -> Bool
Node -> Node -> Ordering
Node -> Node -> Node
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Node -> Node -> Node
$cmin :: Node -> Node -> Node
max :: Node -> Node -> Node
$cmax :: Node -> Node -> Node
>= :: Node -> Node -> Bool
$c>= :: Node -> Node -> Bool
> :: Node -> Node -> Bool
$c> :: Node -> Node -> Bool
<= :: Node -> Node -> Bool
$c<= :: Node -> Node -> Bool
< :: Node -> Node -> Bool
$c< :: Node -> Node -> Bool
compare :: Node -> Node -> Ordering
$ccompare :: Node -> Node -> Ordering
$cp1Ord :: Eq Node
Ord)
data Edge = Edge (String, String) deriving (Edge -> Edge -> Bool
(Edge -> Edge -> Bool) -> (Edge -> Edge -> Bool) -> Eq Edge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edge -> Edge -> Bool
$c/= :: Edge -> Edge -> Bool
== :: Edge -> Edge -> Bool
$c== :: Edge -> Edge -> Bool
Eq, Eq Edge
Eq Edge =>
(Edge -> Edge -> Ordering)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Bool)
-> (Edge -> Edge -> Edge)
-> (Edge -> Edge -> Edge)
-> Ord Edge
Edge -> Edge -> Bool
Edge -> Edge -> Ordering
Edge -> Edge -> Edge
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Edge -> Edge -> Edge
$cmin :: Edge -> Edge -> Edge
max :: Edge -> Edge -> Edge
$cmax :: Edge -> Edge -> Edge
>= :: Edge -> Edge -> Bool
$c>= :: Edge -> Edge -> Bool
> :: Edge -> Edge -> Bool
$c> :: Edge -> Edge -> Bool
<= :: Edge -> Edge -> Bool
$c<= :: Edge -> Edge -> Bool
< :: Edge -> Edge -> Bool
$c< :: Edge -> Edge -> Bool
compare :: Edge -> Edge -> Ordering
$ccompare :: Edge -> Edge -> Ordering
$cp1Ord :: Eq Edge
Ord)

instance Show Node where
 show :: Node -> String
show (Node s :: String
s) = String
s

instance Show Edge where
 show :: Edge -> String
show (Edge (s1 :: String
s1, s2 :: String
s2)) = String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ "," String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s2

exampleGraph :: [(String, String)] -> Graph Node Edge
exampleGraph :: [(String, String)] -> Graph Node Edge
exampleGraph conns :: [(String, String)]
conns = Graph :: forall node edge.
(node -> [(edge, node)]) -> (edge -> Int) -> Graph node edge
Graph {
 neighbours :: Node -> [(Edge, Node)]
neighbours = \ n :: Node
n -> ((String, String) -> (Edge, Node))
-> [(String, String)] -> [(Edge, Node)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (s1 :: String
s1, s2 :: String
s2) -> ((String, String) -> Edge
Edge (String
s1, String
s2), String -> Node
Node String
s2)) ([(String, String)] -> [(Edge, Node)])
-> [(String, String)] -> [(Edge, Node)]
forall a b. (a -> b) -> a -> b
$
  ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ (s :: String
s, _) -> (String -> Node
Node String
s Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
== Node
n)) [(String, String)]
conns,
 weight :: Edge -> Int
weight = Int -> Edge -> Int
forall a b. a -> b -> a
const 1
}

mapMin :: (a -> a -> Bool) -> Map.Map k a -> Maybe (k, a)
mapMin :: (a -> a -> Bool) -> Map k a -> Maybe (k, a)
mapMin less :: a -> a -> Bool
less = (k -> a -> Maybe (k, a) -> Maybe (k, a))
-> Maybe (k, a) -> Map k a -> Maybe (k, a)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\ k :: k
k a :: a
a b :: Maybe (k, a)
b -> case Maybe (k, a)
b of
 Just (_, a1 :: a
a1) -> if a -> a -> Bool
less a
a1 a
a then Maybe (k, a)
b else (k, a) -> Maybe (k, a)
forall a. a -> Maybe a
Just (k
k, a
a)
 Nothing -> (k, a) -> Maybe (k, a)
forall a. a -> Maybe a
Just (k
k, a
a)) Maybe (k, a)
forall a. Maybe a
Nothing

dijkstra :: (Show node, Show edge, Ord node) => node -> (node -> Bool)
             -> Graph node edge -> Maybe ([(node, edge)], node)
dijkstra :: node
-> (node -> Bool)
-> Graph node edge
-> Maybe ([(node, edge)], node)
dijkstra start :: node
start isEnd :: node -> Bool
isEnd (Graph neighbours_ :: node -> [(edge, node)]
neighbours_ weight_ :: edge -> Int
weight_) =
 let visited :: Map node (Maybe (node, edge), Int)
visited = (Map node (Maybe (node, edge), Int),
 Map node (Maybe (node, edge), Int))
-> Map node (Maybe (node, edge), Int)
forall a b. (a, b) -> b
snd ((Map node (Maybe (node, edge), Int),
  Map node (Maybe (node, edge), Int))
 -> Map node (Maybe (node, edge), Int))
-> (Map node (Maybe (node, edge), Int),
    Map node (Maybe (node, edge), Int))
-> Map node (Maybe (node, edge), Int)
forall a b. (a -> b) -> a -> b
$ (Map node (Maybe (node, edge), Int),
 Map node (Maybe (node, edge), Int))
-> (Map node (Maybe (node, edge), Int),
    Map node (Maybe (node, edge), Int))
adjust ([(node, (Maybe (node, edge), Int))]
-> Map node (Maybe (node, edge), Int)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(node
start, (Maybe (node, edge)
forall a. Maybe a
Nothing, 0))], Map node (Maybe (node, edge), Int)
forall k a. Map k a
Map.empty)
 in case ((Maybe (node, edge), Int) -> (Maybe (node, edge), Int) -> Bool)
-> Map node (Maybe (node, edge), Int)
-> Maybe (node, (Maybe (node, edge), Int))
forall a k. (a -> a -> Bool) -> Map k a -> Maybe (k, a)
mapMin (\ (_, w1 :: Int
w1) (_, w2 :: Int
w2) -> Int
w1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w2) (Map node (Maybe (node, edge), Int)
 -> Maybe (node, (Maybe (node, edge), Int)))
-> Map node (Maybe (node, edge), Int)
-> Maybe (node, (Maybe (node, edge), Int))
forall a b. (a -> b) -> a -> b
$
          (node -> (Maybe (node, edge), Int) -> Bool)
-> Map node (Maybe (node, edge), Int)
-> Map node (Maybe (node, edge), Int)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\ n :: node
n _ -> node -> Bool
isEnd node
n) Map node (Maybe (node, edge), Int)
visited of
     Just (end :: node
end, _) -> Maybe ([(node, edge)], node)
-> ([(node, edge)] -> Maybe ([(node, edge)], node))
-> Maybe [(node, edge)]
-> Maybe ([(node, edge)], node)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe ([(node, edge)], node)
forall a. Maybe a
Nothing (\ p :: [(node, edge)]
p -> ([(node, edge)], node) -> Maybe ([(node, edge)], node)
forall a. a -> Maybe a
Just ([(node, edge)] -> [(node, edge)]
forall a. [a] -> [a]
reverse [(node, edge)]
p, node
end))
               (Maybe [(node, edge)] -> Maybe ([(node, edge)], node))
-> Maybe [(node, edge)] -> Maybe ([(node, edge)], node)
forall a b. (a -> b) -> a -> b
$ node -> Map node (Maybe (node, edge), Int) -> Maybe [(node, edge)]
forall a b b.
Ord a =>
a -> Map a (Maybe (a, b), b) -> Maybe [(a, b)]
extractPath node
end Map node (Maybe (node, edge), Int)
visited
     _ -> Maybe ([(node, edge)], node)
forall a. Maybe a
Nothing
 where
  adjust :: (Map node (Maybe (node, edge), Int),
 Map node (Maybe (node, edge), Int))
-> (Map node (Maybe (node, edge), Int),
    Map node (Maybe (node, edge), Int))
adjust (known :: Map node (Maybe (node, edge), Int)
known, visited :: Map node (Maybe (node, edge), Int)
visited) =
   case ((Maybe (node, edge), Int) -> (Maybe (node, edge), Int) -> Bool)
-> Map node (Maybe (node, edge), Int)
-> Maybe (node, (Maybe (node, edge), Int))
forall a k. (a -> a -> Bool) -> Map k a -> Maybe (k, a)
mapMin (\ (_, w1 :: Int
w1) (_, w2 :: Int
w2) -> Int
w1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w2) Map node (Maybe (node, edge), Int)
known of
    Just (n :: node
n, d :: (Maybe (node, edge), Int)
d@(_, n_weight :: Int
n_weight)) ->
     let (known_ :: Map node (Maybe (node, edge), Int)
known_, visited_ :: Map node (Maybe (node, edge), Int)
visited_) = (node
-> Map node (Maybe (node, edge), Int)
-> Map node (Maybe (node, edge), Int)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete node
n Map node (Maybe (node, edge), Int)
known,
                              node
-> (Maybe (node, edge), Int)
-> Map node (Maybe (node, edge), Int)
-> Map node (Maybe (node, edge), Int)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
n (Maybe (node, edge), Int)
d Map node (Maybe (node, edge), Int)
visited)
     in if node -> Bool
isEnd node
n then (Map node (Maybe (node, edge), Int)
known_, Map node (Maybe (node, edge), Int)
visited_)
        else (Map node (Maybe (node, edge), Int),
 Map node (Maybe (node, edge), Int))
-> (Map node (Maybe (node, edge), Int),
    Map node (Maybe (node, edge), Int))
adjust ((Map node (Maybe (node, edge), Int),
  Map node (Maybe (node, edge), Int))
 -> (Map node (Maybe (node, edge), Int),
     Map node (Maybe (node, edge), Int)))
-> (Map node (Maybe (node, edge), Int),
    Map node (Maybe (node, edge), Int))
-> (Map node (Maybe (node, edge), Int),
    Map node (Maybe (node, edge), Int))
forall a b. (a -> b) -> a -> b
$
         ((Map node (Maybe (node, edge), Int),
  Map node (Maybe (node, edge), Int))
 -> (edge, node)
 -> (Map node (Maybe (node, edge), Int),
     Map node (Maybe (node, edge), Int)))
-> (Map node (Maybe (node, edge), Int),
    Map node (Maybe (node, edge), Int))
-> [(edge, node)]
-> (Map node (Maybe (node, edge), Int),
    Map node (Maybe (node, edge), Int))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ (known' :: Map node (Maybe (node, edge), Int)
known', visited' :: Map node (Maybe (node, edge), Int)
visited') (e :: edge
e, next_n :: node
next_n) ->
          case node
-> Map node (Maybe (node, edge), Int)
-> Maybe (Maybe (node, edge), Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
next_n Map node (Maybe (node, edge), Int)
visited' of
           Just (_, w :: Int
w) -> (Map node (Maybe (node, edge), Int)
known', if Int
n_weight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ edge -> Int
weight_ edge
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w then
                           node
-> (Maybe (node, edge), Int)
-> Map node (Maybe (node, edge), Int)
-> Map node (Maybe (node, edge), Int)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
next_n ((node, edge) -> Maybe (node, edge)
forall a. a -> Maybe a
Just (node
n, edge
e), Int
n_weight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ edge -> Int
weight_ edge
e)
                            Map node (Maybe (node, edge), Int)
visited' else Map node (Maybe (node, edge), Int)
visited')
           Nothing -> (case node
-> Map node (Maybe (node, edge), Int)
-> Maybe (Maybe (node, edge), Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup node
next_n Map node (Maybe (node, edge), Int)
known' of
                       Just (_, w :: Int
w) -> if Int
n_weight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ edge -> Int
weight_ edge
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w then
                        node
-> (Maybe (node, edge), Int)
-> Map node (Maybe (node, edge), Int)
-> Map node (Maybe (node, edge), Int)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
next_n ((node, edge) -> Maybe (node, edge)
forall a. a -> Maybe a
Just (node
n, edge
e), Int
n_weight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ edge -> Int
weight_ edge
e) Map node (Maybe (node, edge), Int)
known'
                        else Map node (Maybe (node, edge), Int)
known'
                       Nothing -> node
-> (Maybe (node, edge), Int)
-> Map node (Maybe (node, edge), Int)
-> Map node (Maybe (node, edge), Int)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert node
next_n
                        ((node, edge) -> Maybe (node, edge)
forall a. a -> Maybe a
Just (node
n, edge
e), Int
n_weight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ edge -> Int
weight_ edge
e) Map node (Maybe (node, edge), Int)
known', Map node (Maybe (node, edge), Int)
visited'))
         (Map node (Maybe (node, edge), Int)
known_, Map node (Maybe (node, edge), Int)
visited_) (node -> [(edge, node)]
neighbours_ node
n)
    Nothing -> (Map node (Maybe (node, edge), Int)
known, Map node (Maybe (node, edge), Int)
visited)
  extractPath :: a -> Map a (Maybe (a, b), b) -> Maybe [(a, b)]
extractPath n :: a
n visited :: Map a (Maybe (a, b), b)
visited = case a -> Map a (Maybe (a, b), b) -> Maybe (Maybe (a, b), b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
n Map a (Maybe (a, b), b)
visited of
   Just (Just (prev :: a
prev, e :: b
e), _) -> case a -> Map a (Maybe (a, b), b) -> Maybe [(a, b)]
extractPath a
prev (a -> Map a (Maybe (a, b), b) -> Map a (Maybe (a, b), b)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete a
n Map a (Maybe (a, b), b)
visited) of
                          Just l :: [(a, b)]
l -> [(a, b)] -> Maybe [(a, b)]
forall a. a -> Maybe a
Just ([(a, b)] -> Maybe [(a, b)]) -> [(a, b)] -> Maybe [(a, b)]
forall a b. (a -> b) -> a -> b
$ (a
prev, b
e) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
l
                          Nothing -> Maybe [(a, b)]
forall a. Maybe a
Nothing
   Just (Nothing, _) -> [(a, b)] -> Maybe [(a, b)]
forall a. a -> Maybe a
Just []
   Nothing -> Maybe [(a, b)]
forall a. Maybe a
Nothing

yen :: (Ord node, Eq edge, Show node, Show edge) => Int -> node -> (node -> Bool)
                                -> Graph node edge -> [([(node, edge)], node)]
yen :: Int
-> node
-> (node -> Bool)
-> Graph node edge
-> [([(node, edge)], node)]
yen k' :: Int
k' start :: node
start end :: node -> Bool
end g :: Graph node edge
g = case node
-> (node -> Bool)
-> Graph node edge
-> Maybe ([(node, edge)], node)
forall node edge.
(Show node, Show edge, Ord node) =>
node
-> (node -> Bool)
-> Graph node edge
-> Maybe ([(node, edge)], node)
dijkstra node
start node -> Bool
end Graph node edge
g of
  Just (shortest_path :: [(node, edge)]
shortest_path, end' :: node
end') -> ([(node, edge)] -> ([(node, edge)], node))
-> [[(node, edge)]] -> [([(node, edge)], node)]
forall a b. (a -> b) -> [a] -> [b]
map (\ p :: [(node, edge)]
p -> ([(node, edge)]
p, node
end')) ([[(node, edge)]] -> [([(node, edge)], node)])
-> [[(node, edge)]] -> [([(node, edge)], node)]
forall a b. (a -> b) -> a -> b
$ Int -> [[(node, edge)]] -> [[(node, edge)]]
yen_ (Int
k' Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) [[(node, edge)]
shortest_path]
  Nothing -> []
 where
  yen_ :: Int -> [[(node, edge)]] -> [[(node, edge)]]
yen_ k :: Int
k a :: [[(node, edge)]]
a = if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then [[(node, edge)]]
a
   else let b :: [[(node, edge)]]
b = (Int -> Maybe [(node, edge)]) -> [Int] -> [[(node, edge)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> [[(node, edge)]] -> Int -> Maybe [(node, edge)]
yen' Int
k [[(node, edge)]]
a) [0 .. ([(node, edge)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[(node, edge)]]
a [[(node, edge)]] -> Int -> [(node, edge)]
forall a. [a] -> Int -> a
!! (Int
k' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)]
        in case [[(node, edge)]] -> Maybe [(node, edge)]
forall a. [[(a, edge)]] -> Maybe [(a, edge)]
minPath [[(node, edge)]]
b of
            Just m :: [(node, edge)]
m -> Int -> [[(node, edge)]] -> [[(node, edge)]]
yen_ (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) ([[(node, edge)]] -> [[(node, edge)]])
-> [[(node, edge)]] -> [[(node, edge)]]
forall a b. (a -> b) -> a -> b
$ [[(node, edge)]]
a [[(node, edge)]] -> [[(node, edge)]] -> [[(node, edge)]]
forall a. [a] -> [a] -> [a]
++ [[(node, edge)]
m]
            Nothing -> [[(node, edge)]]
a
  yen' :: Int -> [[(node, edge)]] -> Int -> Maybe [(node, edge)]
yen' k :: Int
k a :: [[(node, edge)]]
a i :: Int
i =
     let spurNode :: node
spurNode = (node, edge) -> node
forall a b. (a, b) -> a
fst ((node, edge) -> node) -> (node, edge) -> node
forall a b. (a -> b) -> a -> b
$ ([[(node, edge)]]
a [[(node, edge)]] -> Int -> [(node, edge)]
forall a. [a] -> Int -> a
!! (Int
k' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)) [(node, edge)] -> Int -> (node, edge)
forall a. [a] -> Int -> a
!! Int
i
         rootPath :: [(node, edge)]
rootPath = Int -> [(node, edge)] -> [(node, edge)]
forall a. Int -> [a] -> [a]
take Int
i ([[(node, edge)]]
a [[(node, edge)]] -> Int -> [(node, edge)]
forall a. [a] -> Int -> a
!! (Int
k' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1))
         hide :: [(node, edge)]
hide =
          ([(node, edge)] -> [(node, edge)])
-> [[(node, edge)]] -> [(node, edge)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ p :: [(node, edge)]
p -> [[(node, edge)]
p [(node, edge)] -> Int -> (node, edge)
forall a. [a] -> Int -> a
!! Int
i | Int -> [(node, edge)] -> [(node, edge)]
forall a. Int -> [a] -> [a]
take Int
i [(node, edge)]
p [(node, edge)] -> [(node, edge)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(node, edge)]
rootPath]) [[(node, edge)]]
a
         g' :: Graph node edge
g' = Graph node edge
g { neighbours :: node -> [(edge, node)]
neighbours = \ n :: node
n -> ((edge, node) -> Bool) -> [(edge, node)] -> [(edge, node)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ (e :: edge
e, _) -> (node, edge) -> [(node, edge)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem (node
n, edge
e) [(node, edge)]
hide) ([(edge, node)] -> [(edge, node)])
-> [(edge, node)] -> [(edge, node)]
forall a b. (a -> b) -> a -> b
$
                   Graph node edge -> node -> [(edge, node)]
forall node edge. Graph node edge -> node -> [(edge, node)]
neighbours Graph node edge
g node
n }
     in case node
-> (node -> Bool)
-> Graph node edge
-> Maybe ([(node, edge)], node)
forall node edge.
(Show node, Show edge, Ord node) =>
node
-> (node -> Bool)
-> Graph node edge
-> Maybe ([(node, edge)], node)
dijkstra node
spurNode node -> Bool
end Graph node edge
g' of
         Just (spurPath :: [(node, edge)]
spurPath, _) -> [(node, edge)] -> Maybe [(node, edge)]
forall a. a -> Maybe a
Just ([(node, edge)] -> Maybe [(node, edge)])
-> [(node, edge)] -> Maybe [(node, edge)]
forall a b. (a -> b) -> a -> b
$ [(node, edge)]
rootPath [(node, edge)] -> [(node, edge)] -> [(node, edge)]
forall a. [a] -> [a] -> [a]
++ [(node, edge)]
spurPath
         Nothing -> Maybe [(node, edge)]
forall a. Maybe a
Nothing
  minPath :: [[(a, edge)]] -> Maybe [(a, edge)]
minPath (p :: [(a, edge)]
p : ps :: [[(a, edge)]]
ps) = case [[(a, edge)]] -> Maybe [(a, edge)]
minPath [[(a, edge)]]
ps of
   Just m :: [(a, edge)]
m -> [(a, edge)] -> Maybe [(a, edge)]
forall a. a -> Maybe a
Just ([(a, edge)] -> Maybe [(a, edge)])
-> [(a, edge)] -> Maybe [(a, edge)]
forall a b. (a -> b) -> a -> b
$ if [(a, edge)] -> Int
forall a. [(a, edge)] -> Int
pathLen [(a, edge)]
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [(a, edge)] -> Int
forall a. [(a, edge)] -> Int
pathLen [(a, edge)]
m then [(a, edge)]
p else [(a, edge)]
m
   Nothing -> [(a, edge)] -> Maybe [(a, edge)]
forall a. a -> Maybe a
Just [(a, edge)]
p
  minPath [] = Maybe [(a, edge)]
forall a. Maybe a
Nothing
  pathLen :: [(a, edge)] -> Int
pathLen p :: [(a, edge)]
p = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((a, edge) -> Int) -> [(a, edge)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ (_, e :: edge
e) -> (Graph node edge -> edge -> Int
forall node edge. Graph node edge -> edge -> Int
weight Graph node edge
g edge
e)) [(a, edge)]
p

prettyPath :: (Show node, Show edge) => ([(node, edge)], node) -> String
prettyPath :: ([(node, edge)], node) -> String
prettyPath (p :: [(node, edge)]
p, last_node :: node
last_node) =
  let (nodes :: [node]
nodes, edges :: [edge]
edges) = [(node, edge)] -> ([node], [edge])
forall a b. [(a, b)] -> ([a], [b])
unzip [(node, edge)]
p
      (nodes_s :: [String]
nodes_s, edges_s :: [String]
edges_s) = ((node -> String) -> [node] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map node -> String
forall a. Show a => a -> String
show [node]
nodes,
       (edge -> String) -> [edge] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\ e :: edge
e -> " =(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ edge -> String
forall a. Show a => a -> String
show edge
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")=> ") [edge]
edges)
  in (String -> (String, String) -> String)
-> String -> [(String, String)] -> String
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ s :: String
s (n :: String
n, e :: String
e) -> String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e) "" ([String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
nodes_s [String]
edges_s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ node -> String
forall a. Show a => a -> String
show node
last_node

test_graph :: Graph Node Edge
test_graph :: Graph Node Edge
test_graph = [(String, String)] -> Graph Node Edge
exampleGraph [("A", "B"), ("B", "C"), ("B", "E"), ("B", "D"), ("D", "E")]

test :: String
test :: String
test = String
-> (([(Node, Edge)], Node) -> String)
-> Maybe ([(Node, Edge)], Node)
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ([(Node, Edge)], Node) -> String
forall node edge.
(Show node, Show edge) =>
([(node, edge)], node) -> String
prettyPath (Maybe ([(Node, Edge)], Node) -> String)
-> Maybe ([(Node, Edge)], Node) -> String
forall a b. (a -> b) -> a -> b
$
 Node
-> (Node -> Bool)
-> Graph Node Edge
-> Maybe ([(Node, Edge)], Node)
forall node edge.
(Show node, Show edge, Ord node) =>
node
-> (node -> Bool)
-> Graph node edge
-> Maybe ([(node, edge)], node)
dijkstra (String -> Node
Node "A") (Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Node -> Node -> Bool) -> Node -> Node -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Node
Node "E") Graph Node Edge
test_graph

test1 :: [[String]]
test1 :: [[String]]
test1 = ([([(Node, Edge)], Node)] -> [String])
-> [[([(Node, Edge)], Node)]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ((([(Node, Edge)], Node) -> String)
-> [([(Node, Edge)], Node)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ([(Node, Edge)], Node) -> String
forall node edge.
(Show node, Show edge) =>
([(node, edge)], node) -> String
prettyPath)
 [Int
-> Node
-> (Node -> Bool)
-> Graph Node Edge
-> [([(Node, Edge)], Node)]
forall node edge.
(Ord node, Eq edge, Show node, Show edge) =>
Int
-> node
-> (node -> Bool)
-> Graph node edge
-> [([(node, edge)], node)]
yen Int
i (String -> Node
Node "A") (Node -> Node -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Node -> Node -> Bool) -> Node -> Node -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Node
Node "E") Graph Node Edge
test_graph | Int
i <- [1 .. 3]]