Dijkstra's Algorithm in Haskell

Question

I really enjoy Haskell but feel I still have a total beginner's style, and would like to move beyond that. The code below - for Dijkstra's shortest path algorithm - is a case in point. I feel as though I have ended up with a copy of the imperative pseudo code I began with, having done some small transformations, but not the sort of big ones an expert would come up with. (Perhaps it was the very fact that I had pseudo code to start with that got me into this mess - without it would I have pursued a generate and prune strategy?)

But the big decision I needed was how to store the 3 elements of state

• The results
• The Dijkstra scores of the points not yet turned into results; and
• The set of points already found (i.e. the keys of the results)

In the end I used a Vector to Dijkstra scores, and have been passing around my state variables, whereas they could probably have been put into the background with a Monad. I know that having Vector manipulations in two places is not smart (I could probably have reduced that 1 by passing the deletion request into recalc....).

I'd welcome any constructive comments, on how an expert would approach the state challenge.

import qualified Data.ByteString.Char8 as BS
import qualified Data.Vector as V
import qualified Data.List   as L

type NodeName = Int
type Dist = Int
type Edge = (NodeName, Dist)
type Edges = [Edge]
type Graph = V.Vector Edges

-- STATE
type Explored = [NodeName] -- IntSet?
type Results = [(NodeName, Dist)] -- need to add to randomly
type DijkstraScores = V.Vector (Maybe Dist)

-- take top from DijkList
-- add to results
-- get update DijkList
mainLoop :: Graph -> Explored -> DijkstraScores -> Results -> Results
mainLoop gr exs ds res = 
    let 
        minIdx = V.minIndexBy maybeOrder ds
        Just minVal = ds V.! minIdx
        res' = (minIdx,minVal) : res
        exs' = minIdx : exs
        newDists = filter (not . (`elem` exs') . fst) $ gr V.! minIdx
        newDs = recalcDijkDist newDists minVal $ ds V.// [(minIdx,Nothing)] -- remove this value
    in case V.all (==Nothing) newDs of
        True -> res
        False -> mainLoop gr exs' newDs res'

-- run over new Dists
    -- change if lower
    -- leave if higher
    -- add if no existing data
    -- recombine with all other data
recalcDijkDist :: Edges -> Dist -> DijkstraScores -> DijkstraScores
recalcDijkDist newDists distOfNewPoint ds =
    let 
        comps = map process newDists
        process :: Edge -> (Int, Maybe Int)
        process (x,y) = 
            case ds V.! x of
                Just z -> (x, Just $ min (y + distOfNewPoint) z)
                Nothing -> (x, Just $ y + distOfNewPoint)
    in ds V.// comps

getEdges :: String -> IO Graph
getEdges path = do
    -- init removes a trailing '\r'
    lines <- (map (init . (BS.split '\t')) . BS.lines) `fmap` BS.readFile path
    let gr = V.fromList $ ([] :) $ map processLine lines
    return gr

processLine :: [BS.ByteString] -> Edges
processLine (n:connections) = map splitter connections
    where
        myread  = maybe (error "can't read Int") fst . BS.readInt
        splitter c = let
                (x,y) = (\(xx,yy) -> (xx, BS.tail yy)) $ BS.break (==',') c             
            in (myread x, myread y)

main = do
    gr <- getEdges "dijkstra.txt"
    let 
        --mloop = mainLoop gr [] (initDijkstra $ gr V.! 1) []
        mloop = mainLoop gr [] (recalcDijkDist (gr V.! 1) 0 $ V.replicate 201 Nothing) []
        anstoFind = [7,37,59,82,99,115,133,165,188,197]
        -- maybe :: b -> (a -> b) -> Maybe a -> b
        answers = map (\x -> snd $ maybe (error "not found") id $ L.find ((==x).fst) mloop) anstoFind
    return answers
    --return gr

-- Nothing is interpreted as 0 otherwise
maybeOrder :: Maybe Int -> Maybe Int -> Ordering
maybeOrder Nothing x = GT
maybeOrder x Nothing = LT
maybeOrder (Just x) (Just y) = compare x y

Answer 1

Nice exercise!

But the big decision I needed was how to store the 3 elements of state

• The results
• The Dijkstra scores of the points not yet turned into results; and
• The set of points already found (i.e. the keys of the results)

An important feature of the algorithm is that the scores are kept in a min-priority-queue. Keeping the scores in a vector requires O(n) cost at every step. Also note that having using a priority queue API would simplify the mainLoop, as the operations on a vector are somewhat low-level wrt the task (remove the minimal value from the queue, if it exists).

The explored nodes form a set, to it'd be indeed more appropriate to use IntSet or Set. Whenever you use elem with [], it's a sign to think of a better data structure (unless you know the list length is bounded by some small constant).

Regarding the results, we know we add each node only once, so [] seems to be OK. Adding is then O(1) and whatever manipulation we want to do at the end can be deferred until then.

I don't think there is anything wrong with your approach to keeping the state. While you could use the State monad (or perhaps RWS where the reader part would be the graph, the writer part the results and the state the scores), it'd force (as any monad) more imperative, sequential style. And it'd cloud which part of the code needs what information. And having the value that's being modified as the last argument (like ... -> Results -> Results) allows to use point-free style where appropriate.

You might want to check if your mainLoop is tail-recursive.

Perhaps one way how to make mainLoop have less imperative feel would be to check for the termination condition first (which isn't such a bad idea, if the input is an empty graph or so). Something like:

mainLoop gr = loop
  where
    loop exs ds res | ifQueueEmpty ds = res
                    | otherwise =
      let ...
      in loop exs' newDs res'

There are multiple reasons for separating the loop in an inner function. One (that doesn't really apply here) is that by having the top-level function non-recursive, it allows it to be inlined. The other is that this clearly expresses what changes during the loop and what not.

---

Some more remarks:

I like that you included types for all functions, including helpers, that's often very convenient. And that you gave descriptive names to the types.

From the types it's not that obvious how are graphs represented. If an edge is

type Edge = (NodeName, Dist)

what is the other node it connects? My guess is that the other node is determined by the index of the [Edge] list in the vector. In any case, this should be documented in comments for the types.

Also, a question comes to my mind, why the graph is a Vector, but the list of edges is a []?

Regarding comments, I'd suggest you to use the Haddock syntax, as it's then very easy to generate documentation from the code.

Also it's not clear what Nothing means in the vector. It could mean that an element hasn't been explored yet (infinite distance), which would work well with manipulating distances, but it seems to be used for elements that have been removed from the queue. I'd rather use a queue that allows proper removal of elements, and use Dist that deals with infinity (see below)

For representing distances it'd be useful to have a separate data type, something like

newtype Dist = Dist (Maybe Int)

with the appropriate Ord instance and supply the minimum monoid instance where mempty is the infinity and mappend takes the minimum of its arguments. For example process could be greatly simplified by this.

The comments are sometimes somewhat misleading, for example in Nothing is interpreted as 0 otherwise it's not clear what "otherwise" means.