diff --git a/collects/data/scribblings/data.scrbl b/collects/data/scribblings/data.scrbl
index 97657d9339..67f2bbfa4f 100644
--- a/collects/data/scribblings/data.scrbl
+++ b/collects/data/scribblings/data.scrbl
@@ -24,3 +24,4 @@ This manual documents data structure libraries available in the
 @include-section["heap.scrbl"]
 @include-section["integer-set.scrbl"]
 @include-section["bit-vector.scrbl"]
+@include-section["union-find.scrbl"]
diff --git a/collects/data/scribblings/union-find.scrbl b/collects/data/scribblings/union-find.scrbl
new file mode 100644
index 0000000000..3a80599714
--- /dev/null
+++ b/collects/data/scribblings/union-find.scrbl
@@ -0,0 +1,80 @@
+#lang scribble/manual
+@(require scribble/eval
+          (for-label data/union-find
+                     racket/contract
+                     racket/base))
+
+@title[#:tag "union-find"]{Union-Find: Sets with only Canonical Elements}
+
+@(define the-eval (make-base-eval))
+@(the-eval '(require data/union-find))
+
+@defmodule[data/union-find]
+
+The union-find algorithm and data structure provides
+an API for representing sets that contain a single,
+element. The sets support an (imperative) union operation,
+as well as getting and setting the canonical element.
+
+These operations are not thread-safe.
+
+@defproc[(uf-new [c any/c]) uf-set?]{
+
+Makes a new set with the canonical element @racket[c].
+
+@examples[#:eval the-eval
+                 (uf-new 'whale)
+                 (uf-new 'dwarf-lantern)]
+}
+
+
+@defproc[(uf-set? [x any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[x] was created with @racket[uf-new],
+        and @racket[#f] otherwise.
+
+@examples[#:eval the-eval
+  (uf-set? (uf-new 'spiny-dogfish))
+  (uf-set? "I am not a uf-set")]
+}
+
+@defproc[(uf-find [a uf-set?]) any/c]{
+  Returns the canonical element of @racket[a].
+                                   
+  @examples[#:eval the-eval
+                   (uf-find (uf-new 'tasselled-wobbegong))]
+}
+
+@defproc[(uf-union! [a uf-set?] [b uf-set?]) void?]{
+
+Imperatively unifies @racket[a] and @racket[b], making
+them both have the same canonical element. Either
+of @racket[a] or @racket[b]'s  canonical elements may
+become the canonical element for the union.
+
+@examples[#:eval the-eval
+  (define a (uf-new 'sand-devil))
+  (define b (uf-new 'pigeye))
+  (uf-union! a b)
+  (uf-find a)
+  (uf-find b)
+]
+}
+
+
+@defproc[(uf-set-canonical! [a uf-set?] [c any/c]) void?]{
+  Changes @racket[a] to have a new canonical element
+
+ @examples[#:eval the-eval
+  (define a (uf-new 'sand-devil))
+  (uf-set-canonical! a 'lemon)
+  (uf-find a)
+  (define b (uf-new 'pigeye))
+  (uf-union! a b)
+  (uf-set-canonical! b 'sicklefin-lemon)
+  (uf-find a)
+]
+          
+}
+
+@close-eval[the-eval]
diff --git a/collects/data/union-find.rkt b/collects/data/union-find.rkt
new file mode 100644
index 0000000000..f211de25a8
--- /dev/null
+++ b/collects/data/union-find.rkt
@@ -0,0 +1,137 @@
+#lang racket/base
+
+(provide uf-set? 
+         uf-new
+         uf-union!
+         uf-find
+         uf-set-canonical!)
+
+(struct uf-set (x rank) #:mutable
+  #:methods gen:custom-write
+  [(define write-proc 
+     (λ (uf port mode)
+       (write-string "#<uf-set: " port)
+       (define recur
+         (case mode
+           [(#t) write]
+           [(#f) display]
+           [else (λ (p port) (print p port mode))]))
+       (recur (uf-find uf) port)
+       (write-string ">" port)))])
+(define (uf-new x) (uf-set (box x) 0))
+(define (uf-union! a b) 
+  (define a-rank (uf-set-rank a))
+  (define b-rank (uf-set-rank b))
+  (cond
+    [(< a-rank b-rank)
+     (set-uf-set-x! a b)]
+    [else
+     (set-uf-set-x! b a)
+     (when (= a-rank b-rank)
+       (set-uf-set-rank! a 1))]))
+(define (uf-find a)
+  (define bx (uf-get-box a))
+  (unbox bx))
+(define (uf-set-canonical! a b)
+  (set-box! (uf-get-box a) b))
+(define (uf-get-box a)
+  (let loop ([a a])
+    (cond
+      [(box? (uf-set-x a))
+       (uf-set-x a)]
+      [else
+       (define fnd (loop (uf-set-x a)))
+       (set-uf-set-x! a fnd)
+       fnd])))
+
+
+(module+ test
+  (require rackunit
+           racket/list)
+  
+  (check-equal? (uf-find (uf-new 1)) 1)
+  (check-equal? (let ([a (uf-new 1)]
+                      [b (uf-new 2)])
+                  (uf-union! a b)
+                  (uf-find a))
+                1)
+  (check-equal? (let ([a (uf-new 1)]
+                      [b (uf-new 2)])
+                  (uf-union! a b)
+                  (uf-find b))
+                1)
+  (check-equal? (let ([a (uf-new 1)]
+                      [b (uf-new 2)])
+                  (uf-union! a b)
+                  (uf-find a)
+                  (uf-find a))
+                1)
+  (check-equal? (let ([a (uf-new 1)]
+                      [b (uf-new 2)])
+                  (uf-union! a b)
+                  (uf-find b)
+                  (uf-find b))
+                1)
+  (check-equal? (let ([sp (open-output-string)])
+                  (display (uf-new "x") sp)
+                  (get-output-string sp))
+                "#<uf-set: x>")
+  (check-equal? (let ([sp (open-output-string)])
+                  (write (uf-new "x") sp)
+                  (get-output-string sp))
+                "#<uf-set: \"x\">")
+  (check-equal? (let ([sp (open-output-string)])
+                  (print (uf-new "x") sp)
+                  (get-output-string sp))
+                "#<uf-set: \"x\">")
+  (check-equal? (let ([sp (open-output-string)])
+                  (define x (vector 1))
+                  (define a (uf-new x))
+                  (vector-set! x 0 a)
+                  (write x sp)
+                  (get-output-string sp))
+                "#0=#(#<uf-set: #0#>)")
+  (check-equal? (let ([sp (open-output-string)])
+                  (define a (uf-new #f))
+                  (uf-set-canonical! a a)
+                  (write a sp)
+                  (get-output-string sp))
+                "#0=#<uf-set: #0#>")
+  
+  
+  (define (check-ranks uf)
+    (let loop ([uf/box uf]
+               [rank -inf.0])
+      (cond
+        [(box? uf/box) (void)]
+        [else 
+         (unless (<= rank (uf-set-rank uf))
+           (error 'check-ranks "failed for ~s" 
+                  (let loop ([uf uf])
+                    (cond
+                      [(box? uf) `(box ,(unbox uf))]
+                      [else `(uf-set ,(loop (uf-set-x uf))
+                                     ,(uf-set-rank uf))]))))
+         (loop (uf-set-x uf/box)
+               (uf-set-rank uf/box))])))
+  
+  (for ([x (in-range 1000)])
+    (define num-sets (+ 2 (random 40)))
+    (define uf-sets 
+      (shuffle
+       (for/list ([x (in-range num-sets)])
+         (uf-new x))))
+    (let loop ([uf-set (car uf-sets)]
+               [uf-sets (cdr uf-sets)])
+      (when (zero? (random 3))
+        (uf-find uf-set))
+      (unless (null? uf-sets)
+        (uf-union! uf-set (car uf-sets))
+        (loop (car uf-sets)
+              (cdr uf-sets))))
+    (check-true
+     (apply = (map uf-find uf-sets)))
+    
+    (for ([uf (in-list uf-sets)])
+      (check-ranks uf))))
+