Thank you for the example & pointing me to the official name of this problem, Mark! Having done some more digging I found a solution which still uses the "canonical nodes" idea (root nodes of component clusters/subtrees) but does structure it differently and compresses the paths of new nodes as they're being added. For additions it's ~2.5x faster than your version, but ~1.25x slower for lookups (compared to yours)... but altogether still much faster than what I had previously, great!
;; based on WQUPC section of http://www.cs.princeton.edu/~rs/AlgsDS07/01UnionFind.pdf (defn root "Takes a node map `nodes` and node `x`, returns root node of `x`." [nodes x] (loop [x x, nx (nodes x)] (if (= x (or nx x)) x (recur nx nx)))) (defn root* "Like `root`, but compresses path while walking tree. Returns [updated-tree root-node]." [nodes x] (loop [nodes nodes, x x, tx (nodes x x)] (if (= x tx) [nodes x] (let [tx' (nodes tx tx) nodes' (assoc nodes x tx')] (recur nodes' tx' tx'))))) (defn same-as? "Takes a graph structure and two node keys, returns true if keys have same root." [{:keys [nodes]} p q] (= (root nodes p) (root nodes q))) (defn unite "Takes a graph structure and two keys and joins them under a common root node. Compresses paths. Returns updated graph." [{:keys [nodes depth] :or {nodes {} depth {}} :as g} [p q]] (let [[nodes i] (root* nodes p) [nodes j] (root* nodes q) di (depth i 1) dj (depth j 1) [i j] (if (< di dj) [i j] [j i]) g (assoc g :nodes (assoc nodes i j))] (if (= i j) g (assoc g :depth (-> depth (dissoc i) (assoc j (+ di dj))))))) (time (dotimes [i 100000] (def g (reduce unite {} '[[x d] [a b] [b d] [e f] [d y] [c y] [y b] [g e]])))) ;; "Elapsed time: 1399.076 msecs" (time (dotimes [i 100000] (same-as? g 'x 'y))) ;; "Elapsed time: 53.779 msecs" K. On 16 January 2014 20:12, Mark Engelberg <mark.engelb...@gmail.com> wrote: > Whoops, typo, should have been: > "(if (<= (count component1) (count component2))" > > Corrected: > > (defn register-same-as [{:keys [keys->canonical canonical->components] > :as component-graph} > key1 key2] > (let [canonical1 (keys->canonical key1 key1) > canonical2 (keys->canonical key2 key2)] > (if (= canonical1 canonical2) component-graph ; already the same > (let [component1 (canonical->components canonical1 [canonical1]) > component2 (canonical->components canonical2 [canonical2]) > ;swap if necessary so component1 is the smaller component > [canonical1 canonical2 component1 component2] (if (<= (count > component1) (count component2)) > > [canonical1 > canonical2 component1 component2] > [canonical2 > canonical1 component2 component1]) > new-keys->canonical (into keys->canonical (for [item component1] > [item canonical2])) > new-canonical->components (-> canonical->components > (dissoc canonical1) > (assoc canonical2 (into component2 > component1)))] > {:keys->canonical new-keys->canonical, :canonical->components > new-canonical->components})))) > > > > -- > -- > You received this message because you are subscribed to the Google > Groups "Clojure" group. > To post to this group, send email to clojure@googlegroups.com > Note that posts from new members are moderated - please be patient with your > first post. > To unsubscribe from this group, send email to > clojure+unsubscr...@googlegroups.com > For more options, visit this group at > http://groups.google.com/group/clojure?hl=en > --- > You received this message because you are subscribed to the Google Groups > "Clojure" group. > To unsubscribe from this group and stop receiving emails from it, send an > email to clojure+unsubscr...@googlegroups.com. > For more options, visit https://groups.google.com/groups/opt_out. -- Karsten Schmidt http://postspectacular.com | http://toxiclibs.org | http://toxi.co.uk -- -- You received this message because you are subscribed to the Google Groups "Clojure" group. To post to this group, send email to clojure@googlegroups.com Note that posts from new members are moderated - please be patient with your first post. To unsubscribe from this group, send email to clojure+unsubscr...@googlegroups.com For more options, visit this group at http://groups.google.com/group/clojure?hl=en --- You received this message because you are subscribed to the Google Groups "Clojure" group. To unsubscribe from this group and stop receiving emails from it, send an email to clojure+unsubscr...@googlegroups.com. For more options, visit https://groups.google.com/groups/opt_out.
