Last active
June 24, 2023 17:59
-
-
Save alandipert/1263783 to your computer and use it in GitHub Desktop.
Kahn's topological sort in Clojure
This file contains 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 [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 | |
) |
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.
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
Awesome, thanks. Needed this and I was able to use it without a single modification to my original code. Now, try that on Java!