Skip to content

Instantly share code, notes, and snippets.

@alandipert
Last active June 24, 2023 17:59
Show Gist options
  • Star 35 You must be signed in to star a gist
  • Fork 9 You must be signed in to fork a gist
  • Save alandipert/1263783 to your computer and use it in GitHub Desktop.
Save alandipert/1263783 to your computer and use it in GitHub Desktop.
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
)
@spieden
Copy link

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.

@tombarys
Copy link

tombarys commented Jun 26, 2022

Hi, why is there the {:pre [(not (empty? s))]} form in take-1 function? It seems to me it is not useful at all but I am Clojure beginner. Thank you, @alandipert.

EDIT: it throws an error when hash-set is empty – is that the reason?

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