442 PurelyFunctional.tv Newsletter

00 Dijkstra's Algorithm.md

Dijkstra's Algorithm

Write a function to calculate the shortest path between two nodes in a graph using Dijkstra's Algorithm. The graph is directional and is represented as a map. The keys are pairs of nodes and the value is the cost to traverse the edge between them, from the first node to the second node. If a pair of nodes does not exist in the map, it means that there is no edge between them.

Example graph

(def graph {[:a :b] 1
            [:a :c] 2
            [:c :a] 4})

Your function should return a path, consisting of a sequence of the names of the nodes to follow, including the starting end ending nodes.

Example

(shortest-path graph :c :b) ;=> [:c :a :b]
(shortest-path graph :a :a) ;=> [:a]
(shortest-path graph :a :b) ;=> [:a :b]
(shortest-path graph :b :c) ;=> nil (because no path exists)

For a description of the algorithm, see the wikipedia page or any textbook on algorithms.

Please submit your solutions as comments on this gist.

To subscribe: https://purelyfunctional.tv/newsletter/

Implemented the uniform cost variant of the algorithm found here: https://en.wikipedia.org/wiki/Dijkstra%27s_algorithm#Practical_optimizations_and_infinite_graphs

Tried to implement it as best I could using recursion and lazy-sequences

(require '[clojure.data.priority-map :refer [priority-map]])

(defn unexplored-neighbors [explored neighbours]
  (->> neighbours
       (filter (fn [n] (->> n first explored not)))))

(defn djikstra-uniform-cost [graph v u]
  ((fn rec-seq [explored frontier]
     (lazy-seq
      (if (empty? frontier)
        [:end]
        (let [[[source node] cost] (peek frontier)]
          (if (= node u)

            [[[source node] cost]]

            (let [explored (conj explored node)
                  neighbors (graph node)
                  next (map (fn [[u weight]] [[node u] weight]) (unexplored-neighbors explored neighbors))
                  frontier (apply conj (pop frontier) next)]

              (cons [[source node] cost] (rec-seq explored frontier))))))))

   #{} (priority-map [v v] 0)))

(defn solution-reducer
  "Working back from the target (solution reversed),
   if the nodes origin (source) does not equal the next nodes value
   then remove it

   annotated example: (:n should match :src of the one before)
       {:n 9, :src 1} {:n 4, :src 1} {:n 1, :src 6} {:n 6, :src 7} {:n 7, :src 0} {:n 0, :src 0}
    -> {:n 9, :src 1} {:n 1, :src 6} {:n 6, :src 7} {:n 7, :src 0} {:n 0, :src 0}"
  [acc [[_ v] _ :as node]]
  (if (empty? acc) [node]
      (if-let [[[prev-source _] _] (last acc)]
        (if (= prev-source v) (conj acc node) acc))))

(defn find-solution
  "Prune all dead end paths from the solution to reveal the shortest path"
  [path]
  (let [solution (->> path
                      reverse
                      (reduce solution-reducer [])
                      reverse)
        path-nodes (map (fn [[[_ node] _]] node) solution)
        path-weight (reduce + (map second solution))]
    {:path path-nodes
     :cost path-weight}))

(defn shortest-path [graph v u]
  (if-let [path-with-cost (djikstra-uniform-cost graph v u)]
    (when (not= (last path-with-cost) :end)
      (find-solution path-with-cost))))

(def test-graph
  "Adjacency list of form {nodeId [[nodeId edgeWeight] [nodeId edgeWeight] ... ]}"
  {0 [[0 10] [7 1]]
   7 [[6 5] [2 9]]
   1 [[4 1] [5 9] [0 9] [9 6]]
   4 [[4 3] [0 7] [3 8]]
   6 [[1 8]]
   3 [[5 3] [1 9] [7 4] [6 4] [2 5] [0 2]]
   2 [[2 4] [0 4] [6 7]]
   9 [[2 9] [8 3] [9 8]]
   5 [[8 2] [9 5] [4 6]]
   8 [[6 1] [7 8] [5 2]]})

(shortest-path test-graph 0 8) ; => {:path (0 7 6 1 9 8), :cost 23}

I convert the original "graph" input into a nested map. The cost-map is a map of a terminal node key to a vector path of nodes + cost. So the cost is accessed with peek, and the path is accessed with pop. I also keep the unvisited nodes (a set) under a special ::unvisited key in the same cost-map. A more conventional Clojure approach might use a more nested structure with explicit keys for the different kinds of information. Example of my cost-map state: {:b [:c :b 5] :c [:c 0] ::unvisited #{:a :b :d}}.

I was partially inspired by this blog post: http://loganlinn.com/blog/2013/04/22/dijkstras-algorithm-in-clojure/ But I have made a lot of changes so any bugs are my fault.

(defn best-unvisited-path [cost-map]
  (let [unvisited (::unvisited cost-map)]
    (pop (reduce-kv (fn [best k v]
                      (if (and (contains? unvisited k) (< (peek v) (peek best)))
                        v
                        best))
                    [Long/MAX_VALUE]
                    cost-map))))

(defn update-costs [g node cost-map]
  (let [node-cost (peek (cost-map node))
        node-path (pop (cost-map node))
        unvisited (disj (::unvisited cost-map) node)]
    (reduce-kv (fn [cm nbr nbr-step]
                 (if-not (contains? unvisited nbr)
                   cm
                   (let [new-cost (+ node-cost nbr-step)
                         nbr-path-cost (get cm nbr [Long/MAX_VALUE])]
                     (if (< new-cost (peek nbr-path-cost))
                       (assoc cm nbr (conj node-path nbr new-cost))
                       cm))))
               (assoc cost-map ::unvisited unvisited)
               (get g node))))


(defn shortest-path [path-map start end]
  (let [g (reduce-kv assoc-in {} path-map)]
    (loop [cost-map {start [start 0] ::unvisited (into #{} cat (keys path-map))}]
      (let [best-path (best-unvisited-path cost-map)
            node (peek best-path)]
        (cond (nil? node) nil
              (= node end) best-path
              :else (recur (update-costs g node cost-map)))))))

In case that is useful to others, here is the wikipedia example, which is both non-trivial and easy to verify visually:

(def wikipedia-example {[:1 :2] 7
                        [:1 :6] 14
                        [:1 :3] 9

                        [:2 :1] 7
                        [:2 :3] 10
                        [:2 :4] 15

                        [:3 :1] 9
                        [:3 :2] 10
                        [:3 :6] 2
                        [:3 :4] 11

                        [:4 :2] 15
                        [:4 :3] 11
                        [:4 :5] 6

                        [:5 :4] 6
                        [:5 :6] 9

                        [:6 :1] 14
                        [:6 :3] 2
                        [:6 :5] 9})

(shortest-path wikipedia-example :1 :5) ;;=> (:1 :3 :6 :5)
(shortest-path wikipedia-example :5 :4) ;;=> (:5 :4)
(shortest-path wikipedia-example :5 :3) ;;=> (:5 :6 :3)
(shortest-path wikipedia-example :3 :5) ;;=> (:3 :6 :5)
(shortest-path wikipedia-example :2 :6) ;;=> (:2 :3 :6)

(defn nodes [graph]
  (->> graph keys (apply concat) set))

(defn neighbors [node graph]
  (->> graph keys
       (filter #(= node (first %)))
       (map last) set))

(defn init [nodes start]
  (let [distances
        (-> (zipmap nodes (repeat Long/MAX_VALUE))
            (conj [start 0])),
        breadcrumbs
        (-> (zipmap nodes (repeat nil)))]
    {:distances distances
     :breadcrumbs breadcrumbs}))

(defn update-stats [stats neighbors from graph unvisited]
  (let [from-dist (get-in stats [:distances from])]
    (->> unvisited
         (filter neighbors)
         (reduce (fn [{:keys [distances breadcrumbs] :as stats} 
                      kand]
                   (let [kdist (+ from-dist 
                                  (graph [from kand]))
                         stats' (if (< kdist (distances kand))
                                  (-> stats 
                                      (assoc-in [:distances kand] kdist)
                                      (assoc-in [:breadcrumbs kand] from))
                                  stats)]
                     stats'))
                 stats))))

(defn gen-path [{:keys [breadcrumbs]} from]
  (let [path (fn step [path from]
                    (if-not from
                      path
                      (recur (conj path from) (get breadcrumbs from) )))]
    (path nil from)))


(defn best-node [stats unvisited]
  (->> (select-keys (:distances stats) unvisited)
       (reduce (fn [[min _ :as sel] [node dist]]
                 (if (< dist min)
                   [dist node]
                   sel))
               [Long/MAX_VALUE nil])
       second))

(defn shortest-path [graph start dest]
  (loop [current start
         unvisited (disj (nodes graph) start)
         stats (init unvisited start)]
    (let [nbrs (neighbors current graph)]
      (cond 
        (not current) 
        nil
        (not-any? unvisited (conj nbrs dest))
        (gen-path stats dest)
        :else 
        (let [stats' (update-stats stats nbrs current graph unvisited)
              current' (best-node  stats' unvisited) ]
          (recur current' 
                 (disj unvisited current')
                 stats'))))))