Created
July 3, 2015 01:04
-
-
Save standinga/5e54b2c16daa02b5000c to your computer and use it in GitHub Desktop.
SCC
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defn CHECKEDGES [G S unexpl BACKTRACK ORDERLIST] ;aux function checking all edges outgoing from vector S | |
(if (= (G S) []) | |
(if (= BACKTRACK []) | |
[G nil BACKTRACK ORDERLIST] ;nowhere to backtrack anymore new S is nil | |
(recur G (peek BACKTRACK) unexpl (pop BACKTRACK) (conj ORDERLIST S))) ;no more edges to verify, need to backtrack, add S to orderlist | |
; now if (G S) edges are not empty, check all vertices | |
(let [V (peek (G S)) | |
newedges (pop (G S)) | |
newG (assoc G S newedges)] ;new edges are without V anymore | |
(if (unexpl V) | |
[newG V (conj BACKTRACK S) ORDERLIST] ; return V as new S, add S to backtracklist and don't change orderlist | |
(recur newG S unexpl BACKTRACK ORDERLIST))))) | |
(defn DFS2 [G S START unexpl BACKTRACK ORDERLIST] ;main DFS returning modified unexplored list and orderlist for FIRST and SECONDLOOP | |
(if (= S nil) | |
[(conj ORDERLIST START) unexpl] ; returns orderlist and unexplored list | |
(let[newunexplored (assoc unexpl S false)] | |
(let [ | |
[newG V newBACKTRACK newORDERLIST ] (CHECKEDGES G S newunexplored BACKTRACK ORDERLIST)] | |
(recur newG V START newunexplored newBACKTRACK newORDERLIST))))) | |
(defn DFS [ G S unexplored] | |
(DFS2 G S S unexplored [] [])) | |
(defn firstloop [G UNEXPLORED n mainorderlist] ;returns orderlist in which second loop process graph | |
(if (= n (count G)) mainorderlist | |
(if (not (UNEXPLORED n)) (recur G UNEXPLORED (inc n) mainorderlist) | |
(let [ [ temporder newunexplored] (DFS G n UNEXPLORED)] | |
(recur G newunexplored (inc n) (into mainorderlist temporder)))))) | |
(defn secondloop [G UNEXPLORED LEADERS ORDERLIST] ;returns [size of SCCs, leaders of SCCs] | |
(if (= ORDERLIST []) LEADERS ; end of story | |
(let [S (peek ORDERLIST)] ; use orderlist to select node for DFS | |
(if (not (UNEXPLORED S)) (recur G UNEXPLORED LEADERS (pop ORDERLIST)) ; already checked S | |
(let [[temporder newunexplored] (DFS G S UNEXPLORED)] | |
(recur G newunexplored (conj LEADERS [(count temporder) S]) (pop ORDERLIST))))))) | |
(defn SCC [graph largestnode] | |
(let [_ (print " converts to GREV ") | |
GREV (time (v2gr2 graph (inc largestnode))) | |
_ (print " converts to G ") | |
G (time (v2g2 graph (inc largestnode))) | |
_ (print " creates unexplored list ") | |
unexplored (time (createexplored (inc largestnode) []))] | |
(let [_ (print " FIRSTLOOP: ") | |
orderlist (time (firstloop GREV unexplored 1 []))] | |
(print "SECONDLOOP") | |
(time (secondloop G unexplored [] orderlist))))) | |
;; below is code to converting input of [[head tail] [head tail2] [head2 tail3] ...] into graph and revesed graph | |
;; of format: [[] [tail tail2] [tail3]] where graph idexes are heads of vectors | |
;; and extra boolean vector to keep track of checked nodes | |
(defn v2graph2 [v array] | |
(if (= (count v) 0) array | |
(let [index (first (peek v)) | |
tail (second (peek v))] | |
(let [extras (array index)] | |
(recur (pop v) (assoc array index (conj extras tail))))))) | |
(defn v2graphreverse2 [v array] | |
(if (= (count v) 0) array | |
(let [index (second (peek v)) | |
tail (first (peek v))] | |
(let [extras (array index)] | |
(if (= tail index) | |
(recur (pop v) array) | |
(recur (pop v) (assoc array index (conj extras tail)))))))) | |
(defn createarray1 [n to acc] | |
(if (= n to) acc | |
(recur (inc n) to (conj acc [])))) | |
(defn empytvector [n] | |
(createarray1 0 n [])) | |
(defn v2g2 [v n] | |
(v2graph2 v (empytvector n))) | |
(defn v2gr2 [v n] | |
(v2graphreverse2 v (empytvector n))) | |
(defn createexplored [n acc] | |
(if (= n 0) acc | |
(recur (dec n) (conj acc true)))) | |
;; here is example graph: | |
(def t [ [1 7] [2 5] [3 9] [4 1] [5 8] [6 3][6 8][7 9] [7 4] [8 2] [9 6]]) | |
(SCC t 9) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment