## Posted By

Kototama on 10/30/09

# Dijkstra's algorithm in Clojure

/ Published in: Lisp

1. ; kototamo at gmail dot com
2.
3. (use 'clojure.contrib.def)
4.
5. (declare dijkstra build-path add-rdist update-rdists take-minnode)
6.
7.
8. (defn shortest-path
9. ([net root nodedst children distance]
10. " return [path dist]"
11. " net is the graph "
12. " root the source node "
13. " nodedst the destination "
14. " children a function returning the children for a node "
15. " distance a function returning the distance between two nodes "
16. (let [preds (dijkstra net root nodedst children distance)
17. path (build-path preds root nodedst)]
18. (if (nil? path)
19. nil
20. [path (second (preds nodedst))])))
21.
22. ([net root nodedst children]
23. (shortest-path net root nodedst children (constantly 1))))
24.
25. (defn- dijkstra [net root nodedst children distance]
26. (loop [rdists (sorted-map 0 {root root})
27. minnode root
28. preds {root [root 0]}
29. dist 0]
30. ; (printf "minnode = %s preds = %s rdists = %s\n\n\n" minnode preds rdists)
31. (if (empty? rdists)
32. preds
33. (let [[nminnode ndist nrdists npreds] (take-minnode rdists preds)
34. [nnrdists nnpreds] (update-rdists nrdists
35. npreds
36. net
37. nminnode
38. ndist
39. children distance)]
40. (recur nnrdists nminnode nnpreds ndist)))))
41.
42. (defn- build-path [preds root nodedst]
43. "reverse walk on preds to reconstruct the shortest path"
44. (loop [[pred dist] (preds nodedst) path (list nodedst)]
45. (if (nil? pred)
46. nil
47. (if (= pred root)
48. (cons root path)
49. (recur (preds pred) (cons pred path))))))
50.
52. ([rdists node pred dist]
53. "add a known rdist (rdist = distance to the root)"
54. (if-let [nodes (rdists dist)]
55. (assoc rdists dist (assoc nodes node pred))
56. (assoc rdists dist {node pred})))
57.
58. ([rdists node pred dist prevdist]
59. (let [nrdists (add-rdist rdists node pred dist)
60. minnodes (rdists prevdist)
61. nminnodes (dissoc minnodes node)]
62. (if (empty? nminnodes)
63. (dissoc nrdists prevdist)
64. (assoc nrdists prevdist nminnodes)))))
65.
66. (defn- update-rdists [rdists preds net node dist children distance]
67. "return [rdists preds] updated"
68. (reduce (fn [acc x]
69. (let [curdist (+ dist (distance net node x))
70. prevdist (second (preds x))
71. nrdists (first acc)
72. npreds (second acc)]
73. (if (nil? prevdist)
74. [(add-rdist nrdists x node curdist) (assoc npreds x [node curdist])]
75. (if (< curdist prevdist)
76. [(add-rdist nrdists x node curdist prevdist)
77. (assoc npreds x [node curdist])]
78. [nrdists npreds]))))
79. [rdists preds]
80. (children net node)))
81.
82. (defn- take-minnode [rdists preds]
83. "return a vector [minnode dist rdists preds]"
84. (let [ [dist minnodes] (first rdists)
85. [minnode pred] (first minnodes)
86. others (rest minnodes)]
87. [minnode
88. dist
89. (if (empty? others)
90. (dissoc rdists dist)
91. (assoc rdists dist others))
92. (assoc preds minnode [pred dist]) ]))
93.
94.
95. (comment
96.
97. ;;
98. ;; Example (based on the french wikipedia)
99. ;; http://fr.wikipedia.org/wiki/Algorithme_de_Dijkstra
100. ;;
101.
102. (def net {:A {:B 85, :C 217, :E 173},
103. :B {:F 80},
104. :C {:G 186 :H 103},
105. :D {},
106. :E {:J 502},
107. :F {:I 250}
108. :G {},
109. :H {:D 183 :J 167}
110. :I {:J 84},
111. :J {}
112. })
113.
114.
115. (defn children [net node]
116. (keys (net node)))
117.
118. (defn distance [net nodesrc nodedst]
119. ((net nodesrc) nodedst))
120.
121. ;(defn nodes [net]
122. ; (apply hash-set (keys net)))
123.
124. (let [pathinfo (shortest-path net :A :J children distance)]
125. (printf "path = %s\n" pathinfo)) ;; [(:A :C :H :J) 487]
126.
127. ;; with all distances = 1
128. (let [pathinfo (shortest-path net :A :J children)]
129. (printf "path = %s\n" pathinfo)) ;; [(:A :E :J) 2]
130.
131. )