moved contents of unstable/set to racket/set

This commit is contained in:
Ryan Culpepper 2011-04-12 08:48:38 -06:00
parent ccc70fca73
commit 459cce23be
7 changed files with 152 additions and 143 deletions

View File

@ -8,13 +8,16 @@
set? set-eq? set-eqv? set-equal?
set-empty? set-count
set-member? set-add set-remove
set-union set-intersect set-subtract
subset?
set-union set-intersect set-subtract set-symmetric-difference
subset? proper-subset?
set-map set-for-each
(rename-out [*in-set in-set])
for/set for/seteq for/seteqv
for*/set for*/seteq for*/seteqv
set/c)
set/c
set=?
set->list
list->set list->seteq list->seteqv)
(define-serializable-struct set (ht)
#:omit-define-syntaxes
@ -222,17 +225,27 @@
(for/fold ([set set]) ([set2 (in-list sets)])
(set-subtract set set2))]))
(define (subset? set2 set1)
(unless (set? set2) (raise-type-error 'subset? "set" 0 set2 set1))
(unless (set? set1) (raise-type-error 'subset? "set" 0 set2 set1))
(define (subset* who set2 set1 proper?)
(unless (set? set2) (raise-type-error who "set" 0 set2 set1))
(unless (set? set1) (raise-type-error who "set" 0 set2 set1))
(let ([ht1 (set-ht set1)]
[ht2 (set-ht set2)])
(unless (and (eq? (hash-eq? ht1) (hash-eq? ht2))
(eq? (hash-eqv? ht1) (hash-eqv? ht2)))
(raise-mismatch-error 'set-subset? "second set's equivalence predicate is not the same as the first set: "
(raise-mismatch-error who
"second set's equivalence predicate is not the same as the first set: "
set2))
(for/and ([v (in-hash-keys ht2)])
(hash-ref ht1 v #f))))
(and (for/and ([v (in-hash-keys ht2)])
(hash-ref ht1 v #f))
(if proper?
(< (hash-count ht2) (hash-count ht1))
#t))))
(define (subset? one two)
(subset* 'subset? one two #f))
(define (proper-subset? one two)
(subset* 'proper-subset? one two #t))
(define (set-map set proc)
(unless (set? set) (raise-type-error 'set-map "set" 0 set proc))
@ -356,3 +369,55 @@
blame
s
"expected a <~a>, got ~v" (get-name c))))))))))
;; ----
(define (set=? one two)
(unless (set? one) (raise-type-error 'set=? "set" 0 one two))
(unless (set? two) (raise-type-error 'set=? "set" 1 one two))
;; Sets implement prop:equal+hash
(equal? one two))
(define set-symmetric-difference
(case-lambda
[(set)
(unless (set? set) (raise-type-error 'set-symmetric-difference "set" 0 set))
set]
[(set set2)
(unless (set? set) (raise-type-error 'set-symmetric-difference "set" 0 set set2))
(unless (set? set2) (raise-type-error 'set-symmetric-difference "set" 1 set set2))
(let ([ht1 (set-ht set)]
[ht2 (set-ht set2)])
(unless (and (eq? (hash-eq? ht1) (hash-eq? ht2))
(eq? (hash-eqv? ht1) (hash-eqv? ht2)))
(raise-mismatch-error 'set-symmetric-difference
"set's equivalence predicate is not the same as the first set: "
set2))
(let-values ([(big small)
(if (>= (hash-count ht1) (hash-count ht2))
(values ht1 ht2)
(values ht2 ht1))])
(make-set
(for/fold ([ht big]) ([e (in-hash-keys small)])
(if (hash-ref ht e #f)
(hash-remove ht e)
(hash-set ht e #t))))))]
[(set . sets)
(for ([s (in-list (cons set sets))]
[i (in-naturals)])
(unless (set? s) (apply raise-type-error 'set-symmetric-difference "set" i (cons s sets))))
(for/fold ([set set]) ([set2 (in-list sets)])
(set-symmetric-difference set set2))]))
(define (set->list set)
(unless (set? set) (raise-type-error 'set->list "set" 0 set))
(for/list ([elem (in-hash-keys (set-ht set))]) elem))
(define (list->set elems)
(unless (list? elems) (raise-type-error 'list->set "list" 0 elems))
(apply set elems))
(define (list->seteq elems)
(unless (list? elems) (raise-type-error 'list->seteq "list" 0 elems))
(apply seteq elems))
(define (list->seteqv elems)
(unless (list? elems) (raise-type-error 'list->seteqv "list" 0 elems))
(apply seteqv elems))

View File

@ -62,9 +62,6 @@
(define (clause-predicate c)
(literal-predicate (clause-head c)))
(define (set->list s)
(for/list ([e (in-set s)]) e))
(define literal-variables
(match-lambda
[(literal _ _ ts)

View File

@ -110,13 +110,64 @@ runs in time proportional to the total size of all given
@racket[st]s except the first one.}
@defproc[(set-symmetric-difference [st set?] ...+) set?]{
Produces a set containing only those elements found in each
@racket[st] an odd number of times. All of the given @racket[st]s must
use the same equivalence predicate (@racket[equal?], @racket[eq?], or
@racket[eqv?]). This operation runs in time proportional to the total
size of all given @racket[st]s except the first one.
@examples[#:eval set-eval
(set-symmetric-difference (set 1) (set 1 2) (set 1 2 3))
]}
@defproc[(set=? [st set?] [st2 set?]) boolean?]{
Returns @racket[#t] if @racket[st] and @racket[st2] contain the same
members, @racket[#f] otherwise. The @racket[st] and @racket[st2] must
use the same equivalence predicate (@racket[equal?], @racket[eq?], or
@racket[eqv?]). This operation runs in time proportional to the size
of @racket[st].
Equivalent to @racket[(equal? st st2)].
@examples[#:eval set-eval
(set=? (set 1) (set 1 2 3))
(set=? (set 1 2 3) (set 1))
(set=? (set 1 2 3) (set 1 2 3))
]}
@defproc[(subset? [st set?] [st2 set?]) boolean?]{
Returns @racket[#t] if every member of @racket[st] is in
@racket[st2], @racket[#f] otherwise. The @racket[st] and
@racket[st2] must use the same equivalence predicate
(@racket[equal?], @racket[eq?], or @racket[eqv?]). This operation
runs in time proportional to the size of @racket[st].}
runs in time proportional to the size of @racket[st].
@examples[#:eval set-eval
(subset? (set 1) (set 1 2 3))
(subset? (set 1 2 3) (set 1))
(subset? (set 1 2 3) (set 1 2 3))
]}
@defproc[(proper-subset? [st set?] [st2 set?]) boolean?]{
Returns @racket[#t] if every member of @racket[st] is in @racket[st2]
and there is some member of @racket[st2] that is not a member of
@racket[st], @racket[#f] otherwise. The @racket[st] and @racket[st2]
must use the same equivalence predicate (@racket[equal?],
@racket[eq?], or @racket[eqv?]). This operation runs in time
proportional to the size of @racket[st].
@examples[#:eval set-eval
(proper-subset? (set 1) (set 1 2 3))
(proper-subset? (set 1 2 3) (set 1))
(proper-subset? (set 1 2 3) (set 1 2 3))
]}
@defproc[(set-map [st set?]
@ -182,7 +233,27 @@ other forms.}
Analogous to @racket[for/list] and @racket[for*/list], but to
construct a set instead of a list.}
@deftogether[(
@defproc[(list->set [lst list?]) set?]
@defproc[(list->seteq [lst list?]) set?]
@defproc[(list->seteqv [lst list?]) set?]
)]{
Produces the appropriate type of set containing the elements of the
given list. Equivalent to @racket[(apply set lst)], @racket[(apply
seteq lst)], and @racket[(apply seteqv lst)], respectively.
}
@defproc[(set->list [st set?]) list?]{
Produces a list containing the elements of @scheme[st].}
@close-eval[set-eval]
@(define i #'set)
@(define i2 #'set-union)
@(define i2 #'set-union)

View File

@ -1,6 +1,6 @@
#lang racket
(require rackunit rackunit/text-ui unstable/set "helpers.rkt")
(require rackunit rackunit/text-ui racket/set "helpers.rkt")
(define (check/set a-set a-list #:= [== equal?])
(check/sort (set->list a-set) a-list #:= ==))
@ -32,7 +32,7 @@
(test (check-false (proper-subset? (set 1 2 3) (set 1))))
(test (check-false (proper-subset? (set 1 2 3) (set 1 2 3))))))
(test-suite "Combinations"
(test-suite "set-exclusive-or"
(test/set (set-exclusive-or (set 1) (set 1 2) (set 1 2 3)) (list 1 3))
(test/set (set-exclusive-or (set 1) (set 2) (set 3)) (list 1 2 3))
(test/set (set-exclusive-or (set 1 2) (set 2 3) (set 1 3)) (list))))))
(test-suite "set-symmetric-difference"
(test/set (set-symmetric-difference (set 1) (set 1 2) (set 1 2 3)) (list 1 3))
(test/set (set-symmetric-difference (set 1) (set 2) (set 3)) (list 1 2 3))
(test/set (set-symmetric-difference (set 1 2) (set 2 3) (set 1 3)) (list))))))

View File

@ -1,80 +0,0 @@
#lang scribble/manual
@(require scribble/eval "utils.rkt" (for-label racket unstable/set))
@title{Sets}
@defmodule[unstable/set]
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
This module provides tools for representing finite sets.
@deftogether[(
@defproc[(list->set [lst list?]) set?]
@defproc[(list->seteq [lst list?]) set?]
@defproc[(list->seteqv [lst list?]) set?]
)]{
Produces the appropriate type of set containing the elements of the given list.
@defexamples[
#:eval (eval/require 'racket/set 'unstable/set)
(define lst
(list 'atom (expt 2 100) (list 'compound)
'atom (expt 2 100) (list 'compound)))
(list->set lst)
(list->seteqv lst)
(list->seteq lst)
]
}
@defproc[(set=? [a set?] [b set?]) boolean?]{
Reports whether two sets contain the same elements.
@defexamples[
#:eval (eval/require 'racket/set 'unstable/set)
(set=? (set 1) (set 1 2 3))
(set=? (set 1 2 3) (set 1))
(set=? (set 1 2 3) (set 1 2 3))
]
}
@defproc[(proper-subset? [a set?] [b set?]) boolean?]{
Reports whether @scheme[b] contains all of the elements of @scheme[a], and at
least one element not in @scheme[a].
@defexamples[
#:eval (eval/require 'racket/set 'unstable/set)
(proper-subset? (set 1) (set 1 2 3))
(proper-subset? (set 1 2 3) (set 1))
(proper-subset? (set 1 2 3) (set 1 2 3))
]
}
@defproc[(set->list [s set?]) list?]{
Produces a list containing the elements of @scheme[s].
@defexamples[
#:eval (eval/require 'racket/set 'unstable/set)
(set->list (set 1 2 3))
]
}
@defproc[(set-exclusive-or [s set?] ...+) set?]{
Produces a set containing only those elements found in each @scheme[s] an odd
number of times.
@defexamples[
#:eval (eval/require 'racket/set 'unstable/set)
(set-exclusive-or (set 1) (set 1 2) (set 1 2 3))
]
}

View File

@ -96,7 +96,6 @@ Keep documentation and tests up to date.
@include-section["pretty.scrbl"]
@include-section["require.scrbl"]
@include-section["sequence.scrbl"]
@include-section["set.scrbl"]
@include-section["sexp-diff.scrbl"]
@include-section["string.scrbl"]
@include-section["struct.scrbl"]

View File

@ -1,43 +0,0 @@
#lang racket/base
(require racket/set racket/contract)
(define (set->list set)
(for/list ([elem (in-set set)]) elem))
(define (list->set elems) (apply set elems))
(define (list->seteq elems) (apply seteq elems))
(define (list->seteqv elems) (apply seteqv elems))
(define (set=? one two)
;; Sets implement prop:equal+hash
(equal? one two))
(define (proper-subset? one two)
(and (< (set-count one) (set-count two))
(subset? one two)))
(define (set-exclusive-or s0 . rest)
(for/fold ([s s0]) ([s* (in-list rest)])
(define-values [ big small ]
(if (>= (set-count s) (set-count s*))
(values s s*)
(values s* s)))
(for/fold ([s big]) ([e (in-set small)])
(if (set-member? s e)
(set-remove s e)
(set-add s e)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Exports
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide/contract
[list->set (-> list? set?)]
[list->seteq (-> list? set?)]
[list->seteqv (-> list? set?)]
[set->list (-> set? list?)]
[set=? (-> set? set? boolean?)]
[proper-subset? (-> set? set? boolean?)]
[set-exclusive-or (->* [set?] [] #:rest (listof set?) set?)])