-
-
Save crisptrutski/ec8dafa52a2fa81a724008b912f4a91e to your computer and use it in GitHub Desktop.
Kahn's topological sort in Clojure
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
;; 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 [union]]) | |
(:import | |
(clojure.lang PersistentQueue))) | |
(defn take-1 | |
"Returns the pair [element, s'] where s' is set s with element removed." | |
[s] {:pre [(not (empty? s))]} | |
[(peek s) (pop s)]) | |
(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] | |
(set (keys (remove (comp seq val) g)))) | |
(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] | |
(let [g (normalize g) | |
s (no-incoming g)] | |
(kahn-sort (reduce dissoc g s) [] (into PersistentQueue/EMPTY s)))) | |
([g l s] | |
(if (empty? s) | |
(when (every? empty? (vals g)) l) | |
(let [[n s'] (take-1 s) | |
g' (reduce #(update %1 %2 disj n) g (keys g)) | |
s'' (no-incoming g')] | |
(recur (reduce dissoc g' s'') (conj l n) (into s' s'')))))) | |
(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! | |
(= [2 9 10 11 8 5 7 3] (kahn-sort acyclic-g)) | |
(nil? (kahn-sort cyclic-g))) |
Author
crisptrutski
commented
Mar 14, 2017
- Treating dependencies in reverse order (child -> parents)
- "Better" ordering - ie. favour "dependencies satisfied first" nodes
Used built-in persistent queue instead of linked/set
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment