Create a gist now

Instantly share code, notes, and snippets.

Kahn's topological sort in Clojure
;; Copyright (c) Alan Dipert. All rights reserved.
;; The use and distribution terms for this software are covered by the
;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.
(ns alandipert.kahn
(:require [clojure.set :refer [difference union intersection]]))
(defn without
"Returns set s with x removed."
[s x] (difference s #{x}))
(defn take-1
"Returns the pair [element, s'] where s' is set s with element removed."
[s] {:pre [(not (empty? s))]}
(let [item (first s)]
[item (without s item)]))
(defn no-incoming
"Returns the set of nodes in graph g for which there are no incoming
edges, where g is a map of nodes to sets of nodes."
[g]
(let [nodes (set (keys g))
have-incoming (apply union (vals g))]
(difference nodes have-incoming)))
(defn normalize
"Returns g with empty outgoing edges added for nodes with incoming
edges only. Example: {:a #{:b}} => {:a #{:b}, :b #{}}"
[g]
(let [have-incoming (apply union (vals g))]
(reduce #(if (get % %2) % (assoc % %2 #{})) g have-incoming)))
(defn kahn-sort
"Proposes a topological sort for directed graph g using Kahn's
algorithm, where g is a map of nodes to sets of nodes. If g is
cyclic, returns nil."
([g]
(kahn-sort (normalize g) [] (no-incoming g)))
([g l s]
(if (empty? s)
(when (every? empty? (vals g)) l)
(let [[n s'] (take-1 s)
m (g n)
g' (reduce #(update-in % [n] without %2) g m)]
(recur g' (conj l n) (union s' (intersection (no-incoming g') m)))))))
(comment
(def acyclic-g
{7 #{11 8}
5 #{11}
3 #{8 10}
11 #{2 9}
8 #{9}})
(def cyclic-g
{7 #{11 8}
5 #{11}
3 #{8 10}
11 #{2 9}
8 #{9}
2 #{11}}) ;oops, a cycle!
(kahn-sort acyclic-g) ;=> [3 5 7 8 10 11 2 9]
(kahn-sort cyclic-g) ;=> nil
)
@narkisr
narkisr commented Mar 30, 2013

Could you please add a license?

Thanks

@jjcomer
jjcomer commented May 10, 2013

+1 for a license.
Also you can remove items from a set without performing a difference:

(disj s x)
@alandipert
Owner

@narkisr @jjcomer updated w/ license. Stuck with difference so that it works on values that aren't sets.

@manuel-sugawara

Awesome, thanks. Needed this and I was able to use it without a single modification to my original code. Now, try that on Java!

@spieden
spieden commented Jun 17, 2016

Also used to good effect! I'm not sure what you mean by working on non-set values by using difference, though, @alandipert, as "difference" only works on sets as much as "disj" does.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment