Permalink
Browse files

bipartite functions

  • Loading branch information...
1 parent e58afa0 commit 490618255f925a516c80ffd0127be14c7a08aeab @jkk committed Oct 12, 2010
Showing with 58 additions and 1 deletion.
  1. +47 −1 src/loom/alg.clj
  2. +11 −0 test/loom/test/alg.clj
View
@@ -278,4 +278,50 @@ can use these functions."
[#{} []]
(edges g)))))
-;; TODO: MST, coloring, bipartite, matching, etc etc
+(defn bipartite-color
+ "Attempt a two-coloring of graph g. When successful, returns a map of
+ nodes to colors (1 or 0). Otherwise, returns nil."
+ [g]
+ (letfn [(color-component [coloring start]
+ (loop [coloring (assoc coloring start 1)
+ queue (conj clojure.lang.PersistentQueue/EMPTY start)]
+ (if (empty? queue)
+ coloring
+ (let [v (peek queue)
+ color (- 1 (coloring v))
+ nbrs (nb g v)]
+ ;; TODO: could be better
+ (if (some #(and (coloring %) (= (coloring v) (coloring %)))
+ nbrs)
+ nil ;not bipartite
+ (let [nbrs (remove coloring nbrs)]
+ (recur (into coloring (for [nbr nbrs] [nbr color]))
+ (into (pop queue) nbrs))))))))]
+ (loop [[node & nodes] (seq (nodes g))
+ coloring {}]
+ (when coloring
+ (if (nil? node)
+ coloring
+ (if (coloring node)
+ (recur nodes coloring)
+ (recur nodes (color-component coloring node))))))))
+
+(defn bipartite?
+ "Return true if g is bipartite"
+ [g]
+ (boolean (bipartite-color g)))
+
+(defn bipartite-sets
+ "Return two sets of nodes, one for each color of the bipartite coloring,
+ or nil if g is not bipartite"
+ [g]
+ (when-let [coloring (bipartite-color g)]
+ (reduce
+ (fn [[s1 s2] [node color]]
+ (if (zero? color)
+ [(conj s1 node) s2]
+ [s1 (conj s2 node)]))
+ [#{} #{}]
+ coloring)))
+
+;; TODO: MST, coloring, matching, etc etc
View
@@ -138,3 +138,14 @@
#{9 10} (set (loners (add-nodes g8 9 10)))
;; TODO: the rest
))
+
+(deftest bipartite-test
+ (are [expected got] (= expected got)
+ {0 1, 1 0, 5 0, 2 1, 3 1, 4 0} (bipartite-color g6)
+ {5 1, 1 1, 2 0, 3 0, 4 0, 6 0, 7 0, 8 0} (bipartite-color g8)
+ nil (bipartite-color g1)
+ true (bipartite? g6)
+ true (bipartite? g8)
+ false (bipartite? g1)
+ #{#{2 3 4 6 7 8} #{1 5}} (set (bipartite-sets g8))))
+

0 comments on commit 4906182

Please sign in to comment.