From 3fbdbbd85bafeee422662cf5611cb358079218d6 Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Tue, 5 May 2015 21:47:56 +1200 Subject: [PATCH 1/2] Clean up ns and make code more idiomatic --- src/loom/alg.clj | 18 +++++++++--------- src/loom/alg_generic.clj | 7 +++---- src/loom/flow.clj | 4 ++-- src/loom/graph.clj | 8 ++++---- src/loom/io.clj | 15 +++++++-------- 5 files changed, 25 insertions(+), 27 deletions(-) diff --git a/src/loom/alg.clj b/src/loom/alg.clj index 72260c9..d94b512 100644 --- a/src/loom/alg.clj +++ b/src/loom/alg.clj @@ -4,13 +4,13 @@ can use these functions." :author "Justin Kramer"} loom.alg (:require [loom.alg-generic :as gen] - [loom.flow :as flow]) - (:require [loom.graph + [loom.flow :as flow] + [loom.graph :refer [add-nodes add-edges nodes edges successors weight predecessors out-degree in-degree weighted? directed? graph transpose] :as graph] - [loom.alg-generic :refer [trace-path preds->span]]) - (:require [clojure.data.priority-map :as pm] + [loom.alg-generic :refer [trace-path preds->span]] + [clojure.data.priority-map :as pm] [clojure.set :as clj.set])) ;;; @@ -311,7 +311,7 @@ can use these functions." false (let [dist (if (weighted? g) (weight g) - (fn [u v] (if (graph/has-edge? g u v) 1 nil)))] + (fn [u v] (when (graph/has-edge? g u v) 1)))] (reduce (fn [acc node] (assoc acc node (gen/dijkstra-span (successors g) dist node))) {} @@ -432,9 +432,9 @@ can use these functions." color (- 1 (coloring v)) nbrs (graph/successors g v)] ;; TODO: could be better - (if (some #(and (coloring %) (= (coloring v) (coloring %))) + (when-not (some #(and (coloring %) (= (coloring v) (coloring %))) nbrs) - nil ;not bipartite + ;not bipartite (let [nbrs (remove coloring nbrs)] (recur (into coloring (for [nbr nbrs] [nbr color])) (into (pop queue) nbrs))))))))] @@ -474,7 +474,7 @@ can use these functions." successors (concat successors (graph/predecessors g node)))] - (set (filter (complement nil?) + (set (remove nil? (map #(get coloring %) neighbors))))) @@ -621,7 +621,7 @@ can use these functions." curr-dist ((second (peek q)) 2) ;; update path explored (assoc explored curr-node ((second (peek q)) 1)) - nbrs (filter (complement explored) (successors g curr-node)) + nbrs (remove explored (successors g curr-node)) ;; we do this for following reasons ;; a. avoiding duplicate heuristics computation ;; b. duplicate entries for nodes, which needs to be removed later diff --git a/src/loom/alg_generic.clj b/src/loom/alg_generic.clj index 551820a..275e201 100644 --- a/src/loom/alg_generic.clj +++ b/src/loom/alg_generic.clj @@ -83,7 +83,7 @@ seen))))) (when-let [parent (peek stack)] (recur successors parent (peek nbrstack) - (pop stack) (pop nbrstack) (conj seen start)))))] + (pop stack) (pop nbrstack) (conj seen start)))))] (when-not (seen start) (step successors start (successors start) [] [] (conj seen start))))) @@ -133,9 +133,8 @@ once for each direction." [successors start & {:keys [seen return-seen] :or {seen #{}}}] (if (seen start) - (if return-seen - [nil seen] - nil) + (when return-seen + [nil seen]) (loop [start start nbrs (successors start) stack [] diff --git a/src/loom/flow.clj b/src/loom/flow.clj index 5a244ca..25d4cdb 100644 --- a/src/loom/flow.clj +++ b/src/loom/flow.clj @@ -1,7 +1,7 @@ (ns ^{:doc "Algorithms for solving network flow" :author "Robert Lachlan"} loom.flow - (:require [loom.alg-generic :as gen :only [bf-path]])) + (:require [loom.alg-generic :as gen :refer [bf-path]])) (defn residual-capacity @@ -74,7 +74,7 @@ [successors predecessors capacity flow s t] (gen/bf-path (fn [vertex] - (distinct (filter #(> (residual-capacity capacity flow vertex %) 0) + (distinct (filter #(pos? (residual-capacity capacity flow vertex %)) (concat (successors vertex) (predecessors vertex))))) s t)) diff --git a/src/loom/graph.clj b/src/loom/graph.clj index 9da4c8f..43dceca 100644 --- a/src/loom/graph.clj +++ b/src/loom/graph.clj @@ -45,7 +45,7 @@ on adjacency lists." (extend-type clojure.lang.IPersistentVector Edge (src [edge] (get edge 0)) - (dest [edge] (get edge 1))) + (dest [edge] (get edge 1))) ; Default implementation for maps (extend-type clojure.lang.IPersistentMap @@ -108,7 +108,7 @@ on adjacency lists." (contains? (get-in g [:adj n1]) n2)) :out-degree (fn [g node] (count (get-in g [:adj node]))) - :out-edges (fn + :out-edges (fn ([g] (partial out-edges g)) ([g node] (for [n2 (successors g node)] [node n2])))} @@ -144,7 +144,7 @@ on adjacency lists." ([g node] (get-in g [:in node]))) :in-degree (fn [g node] (count (get-in g [:in node]))) - :in-edges (fn + :in-edges (fn ([g] (partial in-edges g)) ([g node] (for [n2 (predecessors g node)] [n2 node])))}) @@ -430,7 +430,7 @@ on adjacency lists." (defn subgraph "Return a graph without all but the given nodes" [g ns] - (remove-nodes* g (filter (complement (set ns)) (nodes g)))) + (remove-nodes* g (remove (set ns) (nodes g)))) (defn add-path "Add a path of edges connecting the given nodes in order" diff --git a/src/loom/io.clj b/src/loom/io.clj index 1b3ec2c..8113d7a 100644 --- a/src/loom/io.clj +++ b/src/loom/io.clj @@ -41,11 +41,11 @@ (let [d? (directed? g) w? (weighted? g) a? (attr? g) - node-label (if node-label node-label + node-label (or node-label (if a? #(attr g % :label) (constantly nil))) - edge-label (if edge-label edge-label + edge-label (or edge-label (cond a? #(if-let [a (attr g %1 %2 :label)] a @@ -115,12 +115,11 @@ ;; There's an 'open' method in java.awt.Desktop but it hangs on Windows ;; using Clojure Box and turns the process into a GUI process on Max OS X. ;; Maybe it's ok for Linux? - (do - (condp = (os) - :mac (sh "open" (str f)) - :win (sh "cmd" (str "/c start " (-> f .toURI .toURL str))) - :unix (sh "xdg-open" (str f))) - nil))) + (condp = (os) + :mac (sh "open" (str f)) + :win (sh "cmd" (str "/c start " (-> f .toURI .toURL str))) + :unix (sh "xdg-open" (str f))) + nil)) (defn- open-data "Write the given data (string or bytes) to a temporary file with the From d961932d52e96301d056edccbc57904fdea5dcdb Mon Sep 17 00:00:00 2001 From: Daniel Compton Date: Sun, 28 Jun 2015 16:17:07 +1200 Subject: [PATCH 2/2] Revert change to bipartite-color --- src/loom/alg.clj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/loom/alg.clj b/src/loom/alg.clj index d94b512..8f0b11c 100644 --- a/src/loom/alg.clj +++ b/src/loom/alg.clj @@ -432,9 +432,9 @@ can use these functions." color (- 1 (coloring v)) nbrs (graph/successors g v)] ;; TODO: could be better - (when-not (some #(and (coloring %) (= (coloring v) (coloring %))) + (if (some #(and (coloring %) (= (coloring v) (coloring %))) nbrs) - ;not bipartite + nil ; graph is not bipartite (let [nbrs (remove coloring nbrs)] (recur (into coloring (for [nbr nbrs] [nbr color])) (into (pop queue) nbrs))))))))]