User Tools

Site Tools


study:algorithmes:shortest

최단 경로

플로이드 알고리즘(Floyd's Algorithm)

: 모든 정점으로부터 다른 모든 곳으로 가는 최단경로. 모든 쌍의 최단경로

와샬 알고리즘의 변형

(defn create-graph [nodes distances] 
        {:nodes nodes :distances distances}) 

(defn processed [k i j D P] 
        (let 
                [S (+ (D [i k] 9999) (D [k j] 9999))] 
                (if 
                        (< S (D [i j] 9999)) 
                        (do 
                                [        (assoc D [i j] S) 
                                        (assoc P [i j] k)]) 
                        [D P]))) 

(defn shortest-path-before-k 
        [k n distances previous] 
        (loop [i 1 DP [distances previous]] 
                (if (< i n) 
                        (recur 
                                (+ i 1) 
                                (loop [        j                        1 
                                                                [D P] DP] 
                                        (if (< j n) 
                                                (recur 
                                                        (+ j 1) 
                                                        (processed k i j D P)) 
                                                [D P]))) 
                        DP))) 

(defn Floyd-Warshall [G] 
        (let [n (count (G :nodes))] 
                (loop        [k 1, 
                                        distances (G :distances), 
                                        previous {}] 
                        (if 
                                (< k n) 
                                (let 
                                        [DP (shortest-path-before-k k n distances previous)] 
                                        (recur (+ k 1) (first DP) (second DP))) 
                                [distances previous])))) 


;;data for testing 
(def G 
        (create-graph 
                [0 1 2 3 4 5 6 7 8] 
                {        [0 1] 1, [0 3] 1, 
                        [1 2] 1, 
                        [2 0] 1, 
                        [3 0] 1, [3 4] 1, [3 6] 1, 
                        [4 5] 1, 
                        [5 3] 1, 
                        [6 3] 1, [6 7] 1, 
                        [7 8] 1, 
                        [8 6] 1})) 

;;data for testing - Android lock pattern map
(def A 
 (create-graph 
                [1 2 3 4 5 6 7 8 9] 
                {       [1 2] 1, [1 4] 1, [1 5] 1, [1 6] 1, [1 8] 1,
                        [2 1] 1, [2 3] 1, [2 4] 1, [2 5] 1, [2 6] 1, [2 7] 1, [2 9] 1,
                        [3 2] 1, [3 4] 1, [3 5] 1, [3 6] 1, [3 8] 1,
                        [4 1] 1, [4 2] 1, [4 3] 1, [4 5] 1, [4 7] 1, [4 8] 1, [4 9] 1,
                        [5 1] 1, [5 2] 1, [5 3] 1, [5 4] 1, [5 6] 1, [5 7] 1, [5 8] 1, [5 9] 1, 
                        [6 1] 1, [6 2] 1, [6 3] 1, [6 5] 1, [6 7] 1, [6 8] 1, [6 9] 1,
                        [7 2] 1, [7 4] 1, [7 5] 1, [7 6] 1, [7 8] 1,
                        [8 1] 1, [8 3] 1, [8 4] 1, [8 5] 1, [8 6] 1, [8 7] 1, [8 9] 1,
                        [9 2] 1, [9 4] 1, [9 5] 1, [9 6] 1, [9 8]}))



(Floyd-Warshall G) 
[{[4 3] 2, [5 4] 2, [6 5] 3, [7 6] 2, [8 7] 2, [3 3] 2, [4 4] 3, [5 5] 3, [6 6] 2, [7 7] 3, [8 8] 3, [3 4] 1, [4 5] 1, [5 6] 2, [6 7] 1, [7 8] 1, [0 1] 1, [1 2] 1, [3 5] 2, [4 6] 3, [5 7] 3, [6 8] 2, [3 6] 1, [4 7] 4, [5 8] 4, [0 3] 1, [3 7] 2, [4 8] 5, [3 8] 3, [8 3] 2, [7 3] 3, [8 4] 3, [3 0] 1, [6 3] 1, [7 4] 4, [8 5] 4, [5 3] 1, [6 4] 2, [7 5] 5, [8 6] 1, [2 0] 1} {[4 3] 5, [5 4] 3, [6 5] 4, [7 6] 8, [8 7] 6, [3 3] 6, [4 4] 5, [5 5] 4, [6 6] 3, [7 7] 8, [8 8] 7, [5 6] 3, [3 5] 4, [4 6] 5, [5 7] 6, [6 8] 7, [4 7] 6, [5 8] 7, [3 7] 6, [4 8] 7, [3 8] 7, [8 3] 6, [7 3] 8, [8 4] 6, [7 4] 8, [8 5] 6, [6 4] 3, [7 5] 8}]

다이익스트라 (dijkstra algorithm)

: 주어진 정점으로부터 다른 모든 곳으로 가는 최단경로

http://projecteuler.net/problem=83 http://clojure.roboloco.net/?tag=dijkstras-algorithm

(defn euler-83 []
  (let [mat   (load-matrix "/zzz/work/matrix.txt")
        m     (count mat)
        n     (count (first mat))
        cost  (fn [[i j]] (nth (nth mat (dec i)) (dec j)))
        start [1 1]
        goal  [m n]
        goal? (fn [e] (= e goal))
        est   (fn [[i j]] 0)
        neigh (fn [[i j]]
                (merge
                 (when (< i m) {[(inc i) j] (cost [(inc i) j])})
                 (when (< j n) {[i (inc j)] (cost [i (inc j)])})
                 (when (< 1 i) {[(dec i) j] (cost [(dec i) j])})
                 (when (< 1 j) {[i (dec j)] (cost [i (dec j)])})))
        path  (a*-search est neigh start goal?)]
    (reduce + (map cost path))))

(time (euler-83))

https://gist.github.com/myfreeweb/1175566

(defn dijkstra [g src]
  (loop [dsts (assoc (zipmap (keys g) (repeat nil)) src 0)
         curr src
         unvi (apply hash-set (keys g))]
    (if (empty? unvi)
      dsts
      (let [unvi  (disj unvi curr)
            nextn (first (sort-by #(% dsts) unvi))
            nrds  (zipmap (keys g) (map #(select-keys % unvi) (vals g)))]
        (if (empty? (curr nrds))
          (recur dsts nextn unvi)
          (let [cdst  (curr dsts)
                roads (select-keys (curr g) unvi)
                reslt (zipmap (keys dsts)
                        (map #(if-let [rd (% roads)]
                                (let [idst (% dsts)
                                      sum  (+ cdst (% roads))]
                                  (if (or (nil? idst)
                                          (< sum idst))
                                    sum idst))
                                (% dsts)) (keys dsts)))]
            (recur reslt nextn unvi)))))))
 
; ---
 
(def demo-graph {:red    {:green 10, :blue   5, :orange 8},
                 :green  {:red 10,   :blue   3},
                 :blue   {:green 3,  :red    5, :purple 7},
                 :purple {:blue 7,   :orange 2},
                 :orange {:purple 2, :red    2}})
 
(prn (dijkstra demo-graph :red))

http://snipplr.com/view/22183/dijkstras-algorithm-in-clojure/

; kototamo at gmail dot com

(use 'clojure.contrib.def)

(declare dijkstra build-path add-rdist update-rdists take-minnode)


(defn shortest-path 
  ([net root nodedst children distance]
     " return [path dist]"
     " net is the graph "
     " root the source node "
     " nodedst the destination "
     " children a function returning the children for a node " 
     " distance a function returning the distance between two nodes "
     (let [preds (dijkstra net root nodedst children distance)
	   path (build-path preds root nodedst)]
       (if (nil? path)
	 nil
	 [path (second (preds nodedst))])))

  ([net root nodedst children]
     (shortest-path net root nodedst children (constantly 1))))

(defn- dijkstra [net root nodedst children distance]
  (loop [rdists (sorted-map 0 {root root})
	 minnode root
	 preds {root [root 0]}
	 dist 0]
    ; (printf "minnode = %s preds = %s rdists = %s\n\n\n" minnode preds rdists)
    (if (empty? rdists)
      preds
      (let [[nminnode ndist nrdists npreds] (take-minnode rdists preds)
	    [nnrdists nnpreds] (update-rdists nrdists 
					      npreds 
					      net 
					      nminnode 
					      ndist 
					      children distance)]
	(recur nnrdists nminnode nnpreds ndist)))))

(defn- build-path [preds root nodedst]
  "reverse walk on preds to reconstruct the shortest path"
  (loop [[pred dist] (preds nodedst) path (list nodedst)]
      (if (nil? pred)
	nil
        (if (= pred root)
          (cons root path)
          (recur (preds pred) (cons pred path))))))

(defn- add-rdist 
  ([rdists node pred dist]
  "add a known rdist (rdist = distance to the root)"
  (if-let [nodes (rdists dist)]
    (assoc rdists dist (assoc nodes node pred))
    (assoc rdists dist {node pred})))

  ([rdists node pred dist prevdist]
     (let [nrdists (add-rdist rdists node pred dist)
	   minnodes (rdists prevdist)
	   nminnodes (dissoc minnodes node)]
       (if (empty? nminnodes)
	 (dissoc nrdists prevdist)
	 (assoc nrdists prevdist nminnodes)))))

(defn- update-rdists [rdists preds net node dist children distance]
  "return [rdists preds] updated"
  (reduce (fn [acc x]
            (let [curdist (+ dist (distance net node x))
                  prevdist (second (preds x))
                  nrdists (first acc)
                  npreds (second acc)]
              (if (nil? prevdist)
                [(add-rdist nrdists x node curdist) (assoc npreds x [node curdist])]
                (if (< curdist prevdist)
                  [(add-rdist nrdists x node curdist prevdist) 
                   (assoc npreds x [node curdist])]
                  [nrdists npreds]))))
          [rdists preds]
          (children net node)))

(defn- take-minnode [rdists preds]
  "return a vector [minnode dist rdists preds]"
  (let [ [dist minnodes] (first rdists)
         [minnode pred] (first minnodes)
         others (rest minnodes)]
    [minnode
     dist
     (if (empty? others)
        (dissoc rdists dist)
        (assoc rdists dist others))
     (assoc preds minnode [pred dist]) ]))


(comment

;;
;; Example (based on the french wikipedia)
;; http://fr.wikipedia.org/wiki/Algorithme_de_Dijkstra
;;

(def net {:A {:B 85, :C 217, :E 173}, 
	  :B {:F 80},
	  :C {:G 186 :H 103},
	  :D {},
	  :E {:J 502},
	  :F {:I 250}
	  :G {},
	  :H {:D 183 :J 167}
	  :I {:J 84},
	  :J {}
	  })


(defn children [net node]
  (keys (net node)))

(defn distance [net nodesrc nodedst]
  ((net nodesrc) nodedst))

;(defn nodes [net]
;  (apply hash-set (keys net)))

(let [pathinfo (shortest-path net :A :J children distance)]
  (printf "path = %s\n" pathinfo)) ;; [(:A :C :H :J) 487]

;; with all distances = 1
(let [pathinfo (shortest-path net :A :J children)]
  (printf "path = %s\n" pathinfo)) ;; [(:A :E :J) 2]

)

외판원 문제(Traveling Salesperson)

해당 문제는 http://en.wikipedia.org/wiki/Ant_colony_optimization_algorithms 개미 집단 알고리즘으로 풀이된 소스입니다.

개미가 복귀할 때, 페로몬을 이용해 최단 거리로 오고, 그 길이 형성되어, 다른 개미들도 최적화된 거리로 복귀하는데서 착안했다고 합니다.

(run-loop n)에서 n은 개미의 수이고 개미의 수에 따라 결과가 영향을 받습니다.

55, 91, 110 라인이 원래 소스에서 변경되었습니다.

55 (doseq p (vals pheromones) -> (doseq [p (vals pheromones)]
91 (doseq edge (map set (partition 2 1 t)) -> (doseq [edge (map set (partition 2 1 t))]
110 (doseq ant @ants -> (doseq [ant @ants]

https://github.com/bgianfo/traveling-salesman/tree/master/clojure

tsp-ants.clj

; Clojure TSP solver using Ant Colony Optimization
; Rich Hickey

;command line for script use, replace 10 below with the number of ants/threads you desire
;java -server -cp clojure.jar clojure.lang.Script tsp-ants.clj -- 10

;basic naive Ant System implementation - see Dorigo et al 1996

(import '(java.util.concurrent.atomic AtomicLong))

;this file defines coords and optimal-tour
(load-file "tsp-data.clj")

(defn distance [coords edge]
  (let [a (coords (first edge)), b (coords (second edge))
        dx (- (:x a) (:x b)), dy (- (:y a) (:y b))
        rxy (Math/sqrt (+ (* dx dx) (* dy dy)))
        txy (int rxy)]
    (if (< txy rxy) (inc txy) txy)))

(def Q 100.0)
(def INIT-P 0.5)
(def P-FACTOR 1.0)
(def D-FACTOR 5.0)
(def E-FACTOR 0.5)

(defn tour-length [tour]
  (reduce + (map #(distance coords %) (map set (partition 2 1 tour)))))

(def optimal-distance 100)

(def nodes (set (keys coords)))
(def edges (set (for [a nodes b nodes :when (not= a b)] #{a b})))
(def distances (reduce (fn [m e] (assoc m e (distance coords e))) {} edges))
(def pheromones (into {} (map #(vector % (ref INIT-P)) edges))) 

(defn prob [edge]
  (* (Math/pow @(pheromones edge) P-FACTOR) 
     (Math/pow (/ 1.0 (distances edge)) D-FACTOR)))

(def probs (reduce (fn [m e] (assoc m e (ref (prob e)))) {} edges))

(def best-length (ref Integer/MAX_VALUE))
(def best-tour (ref Integer/MAX_VALUE))
(def #^AtomicLong tour-count (AtomicLong.))

(def ants (ref nil))
(def running true)

(def evaporator (agent 0))

(defn tick-action [cnt]
  (let [new-cnt (inc cnt)]
    (when (zero? (rem new-cnt (count @ants)))
      (doseq [p (vals pheromones)]
        (dosync (alter p * E-FACTOR))))
    new-cnt))

(defn wrand 
  "Given a vector of slice sizes, returns the index of a slice given a
  random spin of a roulette wheel with compartments proportional to slices."
  [slices]
  (let [total (reduce + slices), r (rand total)]
    (loop [i 0, sum 0]
      (let [newsum (+ (slices i) sum)]
        (if (< r newsum) i (recur (inc i) newsum))))))

(defn get-prob [from to] @(probs #{from to}))

(defn next-stop [node togo]
  (nth (seq togo) (wrand (vec (map get-prob (repeat node) togo)))))

(defn tour []
  (let [home (rand-int (count nodes))
        togo (disj nodes home)]
    (loop [node home, path [], togo togo]
      (if (empty? togo)
        (conj path home)
        (let [next (next-stop node togo)]
          (recur next (conj path node) (disj togo next)))))))

(defn brag [len tour]
  (println "new best, distance:" len)
  (prn tour))

(defn tour-loop [_]
  (when running
    (let [t (tour)
          len (tour-length t)]
      ;drop pheromones, recalc edge probs
      (doseq [edge (map set (partition 2 1 t))]
        (dosync 
         (alter (pheromones edge) + (/ Q len))
         (ref-set (probs edge) (prob edge))))
      ;are we the new best?
      (when (< len @best-length)
        (dosync
         (when (< len @best-length)
           (ref-set best-length len)
           (ref-set best-tour t)))
        (brag len t))
      ;counters, evap
      (.incrementAndGet tour-count)
      (send evaporator tick-action)
      (send-off *agent* #'tour-loop)
      nil)))

(defn run [nants]
  (dosync (ref-set ants (map agent (take nants (repeat nil)))))
  (doseq [ant @ants]
    (send-off ant tour-loop))
  :running)

(defn run-loop  [nants]
  (run nants)
  (println "Running...")
  (let [start (System/currentTimeMillis)]
    (loop []
      (when running
        (Thread/sleep 4000)
        (let [secs (/ (- (System/currentTimeMillis) start) 1000.0)]
          (println "Running" (count nodes) "nodes," nants "ants," tour-count "tours," secs "seconds," 
                   (/ (int (* (/ tour-count secs) 100)) 100.0) "per second, best-so-far:" @best-length 
                   "optimal:" optimal-distance))
        (dorun (map deref @ants))
        (recur)))))

(comment
;repl use
(load-file "tsp-ants.clj")    
(run-loop 10)
;to stop it
(def running false)
)    

;for script use
(when *command-line-args*
  (run-loop (Integer/parseInt (first *command-line-args*))))

tsp-data.clj

(def coords 
{ 0 {:x 36.833333, :y 3.0},
1 {:x -8.833333, :y 13.333333},
2 {:x 6.483333, :y 2.616667},
3 {:x -24.75, :y 25.916667},
4 {:x 12.366667, :y -1.516667},
5 {:x -3.366667, :y 29.316667},
6 {:x 3.85, :y 11.583333},
7 {:x 14.916667, :y -23.516667},
8 {:x 4.383333, :y 18.616667},
9 {:x 12.166667, :y 14.983333},
10 {:x -11.666667, :y 43.266667},
11 {:x -4.233333, :y 15.233333},
12 {:x -4.3, :y 15.3},
13 {:x 6.816667, :y -5.283333},
14 {:x 11.55, :y 43.166667},
15 {:x 30.05, :y 31.25},
16 {:x 3.75, :y 8.8},
17 {:x 15.333333, :y 38.966667},
18 {:x 9.05, :y 38.7},
19 {:x 0.5, :y 9.416667},
20 {:x 13.466667, :y -16.65},
21 {:x 5.55, :y -0.25},
22 {:x 9.483333, :y -13.716667},
23 {:x 11.866667, :y -15.65},
24 {:x -1.283333, :y 36.816667},
25 {:x -29.316667, :y 27.483333},
26 {:x 6.3, :y -10.783333},
27 {:x 32.9, :y 13.183333},
28 {:x -18.866667, :y 47.5},
29 {:x -13.966667, :y 33.816667},
30 {:x 12.65, :y -8.0},
31 {:x 18.15, :y -15.966667},
32 {:x -20.166667, :y 57.5},
33 {:x 34.033333, :y -6.85},
34 {:x -25.966667, :y 32.583333},
35 {:x -22.566667, :y 17.1},
36 {:x 13.533333, :y 2.083333},
37 {:x 9.166667, :y 7.183333},
38 {:x -1.933333, :y 30.066667},
39 {:x 14.666667, :y -17.433333},
40 {:x -4.633333, :y 55.466667},
41 {:x 8.5, :y -13.25},
42 {:x 2.033333, :y 45.35},
43 {:x -25.75, :y 28.2},
44 {:x 15.6, :y 32.533333},
45 {:x -26.333333, :y 31.133333},
46 {:x -6.85, :y 39.3},
47 {:x 6.133333, :y 1.216667},
48 {:x 36.8, :y 10.183333},
49 {:x 0.316667, :y 35.416667},
50 {:x -15.433333, :y 28.333333},
51 {:x -17.833333, :y 31.5} })
study/algorithmes/shortest.txt · Last modified: 2019/02/04 14:26 (external edit)