Strongly connected components implementation in Clojure.

scc.clj

(ns koblik.scc)
(defn dfs
  "Depth first search. Short form of the method passes through all the 
  nodes of the graph even if it's disconnected .
  (nodes-fn graph) expected to return list of all the nodes in the graph.
  (child-fn graph node) expected to return list of all the nodes linked
   to the given node.
  Returns hash-map where nodes are associated with a pair :idx, :leader.
  :idx stores finishing index of the node traversal (post-order counter)
  :leader first finishing index of the current DFS."
  ([graph nodes-fn child-fn]
     (second
      (reduce ;; Start DFS from each node of the graph
       (fn [[idx result passed :as args] next-node]
         (if (not (passed next-node)) ;; Don't do DFS if node is marked
           (dfs idx idx result passed graph next-node child-fn)
           args))
       [0 {} #{}] ;;Initial index, result, set of passed nodes
       (nodes-fn graph))))
  ([idx leader result passed graph node child-fn]
     (let [[idx result passed]
           (reduce (fn [[idx result passed :as args] child-node]
                     (if (not (passed child-node))
                       (dfs idx leader result passed graph child-node child-fn)
                       args))
                   [idx result (conj passed node)]
                   (child-fn graph node))]
       [(inc idx)
        (assoc result node {:idx idx :leader leader})
        passed])))

(defn pass-two 
  "Calls DFS making sure that traversal is done in the reverse :idx order."
  [graph result child-fn]
  (let [nodes-fn 
        (constantly (->> result 
                         ;;Sort by :idx in reverse order
                         (sort-by (comp :idx second)) reverse 
                         ;;Return only nodes
                         (map first)))]
    (dfs graph nodes-fn child-fn)))
  
(defn scc 
  "Finds strongly connected components of the given directed graph.
  Returns lists of nodes grouped into SCC.
  (nodes-fn graph) expected to return list of all the nodes in the graph.
  (incoming-fn graph node) expected to return all the nodes with
   transitions towards the given node.
  (outgoing-fn graph node) expected to return all the nodes with
   transitions from the given node."
  [graph nodes-fn incoming-fn outgoing-fn]
  (let [result (dfs graph nodes-fn incoming-fn)
        leaders-idx (pass-two graph result outgoing-fn)]
    (for [scc-group (vals (group-by (comp :leader second) leaders-idx))]
      (for [[node & _] scc-group] node))))

(defn list-multimap 
  "Builds list multimap: {key1 [val1 val2 ...], key2 [val3 val4 ...]}.
   Each call adds value to the list associated with the key."
  [m [k v]]
  (if (m k)
    (update-in m [k] conj v)
    (assoc m k [v])))

(defn reverse-graph 
  "Reverses list multimap based graph, see below."
  [graph]
  (reduce
   list-multimap
   {}
   (for [[key values] graph v values] [v key])))

(def test-graph 
  {6 [9], 2 [8], 4 [7], 3 [6], 8 [5 6], 1 [4], 9 [3 7], 5 [2], 7 [1]})
;['a 'b 'c 'd 'e 'f 'g 'h 'i 'j]
;  1  2  3  4  5  6  7  8  9  10
;(def test-graph
;  {'a ['g], 'b ['e], 'c ['i], 'd ['a], 'e ['h], 'f ['c 'h], 'g ['d 'i], 'h ['b], 'i ['f]})
(def reverse-test-graph
  (reverse-graph test-graph))

(dfs test-graph 
     ;;fn that returns set of nodes
     (constantly (into #{} (flatten (seq test-graph))))
     ;;(get graph node) returns list of related nodes.
     get) 

(scc test-graph 
     ;;fn that returns set of nodes
     (constantly (into #{} (flatten (seq test-graph))))
     ;;works as incoming-fn using cashed reversed graph
     #(get reverse-test-graph %2) 
     ;;(get graph node) returns list of related nodes
     get)