DijkstraSimple.hs

{-# LANGUAGE ScopedTypeVariables #-}

module Graph.DijkstraSimple
  (
                            -- * How to use this library
                            -- $use
    lightestPaths
  , findPath
  , dijkstraSteps
  , EdgeTo(..)
  , Graph(..)
  , Weighter(..)
  , Path(..)
  , Paths(..)
  )
where

import qualified Data.Map.Lazy                 as M
import qualified Data.List.NonEmpty            as NE
import           Data.Maybe                     ( fromJust
                                                , isJust
                                                , isNothing
                                                )
import           Data.Ord                       ( comparing )
import qualified Data.PriorityQueue.FingerTree as P

-- | Edge to an arbitrary vertex and the associated input weight
data EdgeTo v e = EdgeTo { edgeTo :: v, edgeToWeight :: e } deriving (Eq, Show)

-- | All vertices and outgoing edges
newtype Graph v e = Graph { graphAsMap :: M.Map v [EdgeTo v e] } deriving (Eq, Show)

-- | Convert an input weight (edge-dependant) to an output weight
-- (path-dependant) for the algorithm work.
data Weighter v e a = Weighter { initialWeight :: a, weight :: EdgeTo v e -> Path v e a -> a }
-- | The lightest found path with reverse ordered list of traversed
-- vertices and output weight.
data Path v e a = Path { pathVertices :: NE.NonEmpty v, pathWeight :: a } deriving (Eq, Show)
-- | Reachable vertices and associated lightest paths
newtype Paths v e a = Paths { pathsAsMap :: M.Map v (Path v e a) } deriving (Eq, Show)

-- | Explore all the reachable edges
lightestPaths
  :: forall v e a
   . (Ord v, Ord a)
  => Graph v e
  -> v
  -> Weighter v e a
  -> Paths v e a
lightestPaths graph origin weighter =
  NE.last $ dijkstraSteps graph origin weighter

-- | Find the eventual path between two edges
findPath
  :: forall v e a
   . (Ord v, Ord a)
  => Graph v e
  -> v
  -> Weighter v e a
  -> v
  -> Maybe (Path v e a)
findPath graph origin weighter target =
  pathsAsMap (lightestPaths graph origin weighter) M.!? target

type StatePQ v e a = P.PQueue a (Path v e a, EdgeTo v e)
type State v e a
  = (M.Map v (Path v e a), ((a, (Path v e a, EdgeTo v e)), StatePQ v e a))

-- | Details each step of the Dijkstra algorithm
dijkstraSteps
  :: forall v e a
   . (Ord v, Ord a)
  => Graph v e
  -> v
  -> Weighter v e a
  -> NE.NonEmpty (Paths v e a)
dijkstraSteps graph origin weighter =
  Paths <$> maybe (M.empty NE.:| []) (NE.unfoldr nextStep) init
 where
  init :: Maybe (State v e a)
  init =
    (\p -> (M.empty, p))
      <$> (P.minViewWithKey $ findEdges
            (Path (origin NE.:| []) (initialWeight weighter))
            origin
          )
  nextStep :: State v e a -> (M.Map v (Path v e a), Maybe (State v e a))
  nextStep (paths, ((w, (path, e)), pq)) =
    let npq = if M.notMember (edgeTo e) paths
          then pq `P.union` findEdges path (edgeTo e)
          else pq
        nps = M.alter (updatePath path) (edgeTo e) paths
    in  (nps, (\q -> (nps, q)) <$> P.minViewWithKey npq)
  updatePath :: Path v e a -> Maybe (Path v e a) -> Maybe (Path v e a)
  updatePath p prev = case prev of
    Nothing -> Just p
    Just op -> Just $ if pathWeight op <= pathWeight p then op else p
  findEdges :: Path v e a -> v -> StatePQ v e a
  findEdges path vertice =
    P.fromList
      $ map (buildPath path)
      $ M.findWithDefault [] vertice
      $ graphAsMap graph
  buildPath :: Path v e a -> EdgeTo v e -> (a, (Path v e a, EdgeTo v e))
  buildPath path e = let np = addEdge e path in (pathWeight np, (np, e))
  addEdge :: EdgeTo v e -> Path v e a -> Path v e a
  addEdge e p = Path { pathVertices = edgeTo e NE.<| pathVertices p
                     , pathWeight   = weight weighter e p
                     }

-- $use
--
-- This section contains basic step-by-step usage of the library.
--
-- The first step is to build a direct graph:
--
-- > exampleGraph :: Graph Char Int
-- > exampleGraph = Graph $ M.fromList [
-- >                                     ('A', [EdgeTo 'B' 3, EdgeTo 'C' 1])
-- >                                   , ('B', [EdgeTo 'A' 3, EdgeTo 'C' 7, EdgeTo 'D' 5, EdgeTo 'E' 1])
-- >                                   , ('C', [EdgeTo 'A' 1, EdgeTo 'B' 7, EdgeTo 'D' 2])
-- >                                   , ('D', [EdgeTo 'B' 5, EdgeTo 'C' 2, EdgeTo 'E' 5])
-- >                                   , ('E', [EdgeTo 'B' 1, EdgeTo 'D' 7])
-- >                                   ]
--
-- Then pick or create a weighter (see @Graph.DijkstraSimple.Weighters@)
-- and apply it all:
--
-- > lightestPaths exampleGraph 'C' weighter
--
-- It will give all the reacheable vertices from @'C'@ and associated shortest path:
--
-- > Paths $ M.fromList [
-- >                      ('A', Path (fromList "AC") 1)
-- >                    , ('B', Path (fromList "BAC") 3)
-- >                    , ('C', Path (fromList "CAC") 1)
-- >                    , ('D', Path (fromList "DC") 2)
-- >                    , ('E', Path (fromList "EBAC") 3)
-- >                    ]