Dijkstra's algorithm in Clojure


/ Published in: Lisp
Save to your folder(s)



Copy this code and paste it in your HTML
  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.  
  51. (defn- add-rdist
  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. )

Report this snippet


Comments

RSS Icon Subscribe to comments

You need to login to post a comment.