suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added union-find to the data collection

Browse Source
This commit is contained in:
Robby Findler 2013-01-29 15:47:52 -06:00
parent 5efaa004f0
commit 33747ec9ab
3 changed files with 218 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/data/scribblings/data.scrbl
View File

@ -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"]

80
collects/data/scribblings/union-find.scrbl Normal file
View File

@ -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]

137
collects/data/union-find.rkt Normal file
View File

@ -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))))