Moved unstable/cce/set to unstable/set.
This commit is contained in:
Carl Eastlund
parent
f5b58403ba
commit
5faced0c23
|
|
@ -4,9 +4,10 @@
|
||||||
test-ok check-ok
|
test-ok check-ok
|
||||||
test-bad check-bad
|
test-bad check-bad
|
||||||
check-not
|
check-not
|
||||||
|
check/sort
|
||||||
with/c)
|
with/c)
|
||||||
|
|
||||||
(require rackunit racket/pretty)
|
(require rackunit racket/pretty srfi/67)
|
||||||
|
|
||||||
(define-syntax-rule (test e ...)
|
(define-syntax-rule (test e ...)
|
||||||
(test-case (parameterize ([pretty-print-columns 50])
|
(test-case (parameterize ([pretty-print-columns 50])
|
||||||
|
|
@ -35,3 +36,41 @@
|
||||||
(with-check-info*
|
(with-check-info*
|
||||||
(list (make-check-info 'result result))
|
(list (make-check-info 'result result))
|
||||||
(lambda () (fail-check))))))))
|
(lambda () (fail-check))))))))
|
||||||
|
|
||||||
|
(define (check/sort actual expected
|
||||||
|
#:< [<< (<? default-compare)]
|
||||||
|
#:= [== equal?])
|
||||||
|
(with-check-info*
|
||||||
|
(list (make-check-name 'check/sort)
|
||||||
|
(make-check-info '< <<)
|
||||||
|
(make-check-info '= ==)
|
||||||
|
(make-check-info 'actual actual)
|
||||||
|
(make-check-info 'expected expected))
|
||||||
|
(lambda ()
|
||||||
|
(let* ([actual-sorted (sort actual <<)]
|
||||||
|
[actual-length (length actual-sorted)]
|
||||||
|
[expected-sorted (sort expected <<)]
|
||||||
|
[expected-length (length expected-sorted)])
|
||||||
|
(with-check-info*
|
||||||
|
(list (make-check-info 'actual-sorted actual-sorted)
|
||||||
|
(make-check-info 'expected-sorted expected-sorted))
|
||||||
|
(lambda ()
|
||||||
|
(unless (= actual-length expected-length)
|
||||||
|
(with-check-info*
|
||||||
|
(list (make-check-message
|
||||||
|
(format "expected ~a elements, but got ~a"
|
||||||
|
expected-length actual-length)))
|
||||||
|
(lambda () (fail-check))))
|
||||||
|
(let*-values
|
||||||
|
([(actuals expecteds)
|
||||||
|
(for/lists
|
||||||
|
[actuals expecteds]
|
||||||
|
([actual (in-list actual-sorted)]
|
||||||
|
[expected (in-list actual-sorted)]
|
||||||
|
#:when (not (== actual expected)))
|
||||||
|
(values actual expected))])
|
||||||
|
(unless (and (null? actuals) (null? expecteds))
|
||||||
|
(with-check-info*
|
||||||
|
(list (make-check-info 'actual-failed actuals)
|
||||||
|
(make-check-info 'expected-failed expecteds))
|
||||||
|
(lambda () (fail-check)))))))))))
|
||||||
|
|
|
||||||
38
collects/tests/unstable/set.rkt
Normal file
38
collects/tests/unstable/set.rkt
Normal file
|
|
@ -0,0 +1,38 @@
|
||||||
|
#lang racket
|
||||||
|
|
||||||
|
(require rackunit rackunit/text-ui unstable/set "helpers.rkt")
|
||||||
|
|
||||||
|
(define (check/set a-set a-list #:= [== equal?])
|
||||||
|
(check/sort (set->list a-set) a-list #:= ==))
|
||||||
|
|
||||||
|
(define-syntax-rule (test/set arg ...)
|
||||||
|
(test (check/set arg ...)))
|
||||||
|
|
||||||
|
(run-tests
|
||||||
|
(test-suite "set.ss"
|
||||||
|
(test-suite "Conversions"
|
||||||
|
(test-suite "list->set"
|
||||||
|
(test/set (list->set (list 'a 'b 'c)) (list 'a 'b 'c))
|
||||||
|
(test/set (list->set (list 'c 'b 'a)) (list 'a 'b 'c)))
|
||||||
|
(test-suite "list->seteq"
|
||||||
|
(test/set (list->seteq (list 'a 'b 'c)) (list 'a 'b 'c))
|
||||||
|
(test/set (list->seteq (list 'c 'b 'a)) (list 'a 'b 'c)))
|
||||||
|
(test-suite "list->seteqv"
|
||||||
|
(test/set (list->seteqv (list 'a 'b 'c)) (list 'a 'b 'c))
|
||||||
|
(test/set (list->seteqv (list 'c 'b 'a)) (list 'a 'b 'c)))
|
||||||
|
(test-suite "set->list"
|
||||||
|
(test (check/sort (set->list (set 1 2 3)) (list 1 2 3)))))
|
||||||
|
(test-suite "Comparisons"
|
||||||
|
(test-suite "set=?"
|
||||||
|
(test (check-false (set=? (set 1) (set 1 2 3))))
|
||||||
|
(test (check-false (set=? (set 1 2 3) (set 1))))
|
||||||
|
(test (check-true (set=? (set 1 2 3) (set 1 2 3)))))
|
||||||
|
(test-suite "proper-subset?"
|
||||||
|
(test (check-true (proper-subset? (set 1) (set 1 2 3))))
|
||||||
|
(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))))))
|
||||||
|
|
@ -10,6 +10,4 @@
|
||||||
|
|
||||||
@table-of-contents[]
|
@table-of-contents[]
|
||||||
|
|
||||||
@include-section["set.scrbl"]
|
|
||||||
|
|
||||||
@include-section["debug.scrbl"]
|
@include-section["debug.scrbl"]
|
||||||
|
|
|
||||||
|
|
@ -1,414 +0,0 @@
|
||||||
#lang scribble/doc
|
|
||||||
@(require scribble/manual
|
|
||||||
scribble/eval
|
|
||||||
unstable/scribble
|
|
||||||
"eval.ss")
|
|
||||||
@(require (for-label scheme unstable/cce/set))
|
|
||||||
|
|
||||||
@title[#:style 'quiet #:tag "cce-set"]{Sets}
|
|
||||||
|
|
||||||
@defmodule[unstable/cce/set]
|
|
||||||
|
|
||||||
This module provides tools for representing finite sets.
|
|
||||||
|
|
||||||
@section{Set Constructors}
|
|
||||||
|
|
||||||
@defproc[(set [#:mutable? mutable? boolean? weak?]
|
|
||||||
[#:weak? weak? boolean? #f]
|
|
||||||
[#:compare compare (or/c 'eq 'eqv 'equal) 'equal]
|
|
||||||
[x any/c] ...)
|
|
||||||
set?]{
|
|
||||||
|
|
||||||
Produces a hash table-based set using the hash table properties described by
|
|
||||||
any keyword arguments, and the given values as elements of the set.
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(set 1 2 3)
|
|
||||||
(set #:mutable? #t 1 2 3)
|
|
||||||
(set #:weak? #t 1 2 3)
|
|
||||||
(set #:compare 'eqv 1 2 3)
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(empty-set [#:mutable? mutable? boolean? weak?]
|
|
||||||
[#:weak? weak? boolean? #f]
|
|
||||||
[#:compare compare (or/c 'eq 'eqv 'equal) 'equal])
|
|
||||||
set?]{
|
|
||||||
|
|
||||||
Produces an empty hash table-based set using the hash table properties described
|
|
||||||
by any keyword arguments.
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(empty-set)
|
|
||||||
(empty-set #:mutable? #t)
|
|
||||||
(empty-set #:weak? #t)
|
|
||||||
(empty-set #:compare 'eqv)
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(list->set [#:mutable? mutable? boolean? weak?]
|
|
||||||
[#:weak? weak? boolean? #f]
|
|
||||||
[#:compare compare (or/c 'eq 'eqv 'equal) 'equal]
|
|
||||||
[lst list?])
|
|
||||||
set?]{
|
|
||||||
|
|
||||||
Produces a hash table-based set using the hash table properties described by
|
|
||||||
any keyword arguments, with the elements of the given list as the elements of
|
|
||||||
the set.
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(list->set '(1 2 3))
|
|
||||||
(list->set #:mutable? #t '(1 2 3))
|
|
||||||
(list->set #:weak? #t '(1 2 3))
|
|
||||||
(list->set #:compare 'eqv '(1 2 3))
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(custom-set [#:compare compare (-> any/c any/c any/c)]
|
|
||||||
[#:hash hash (-> any/c exact-integer?) (lambda (x) 0)]
|
|
||||||
[#:hash2 hash2 (-> any/c exact-integer?) (lambda (x) 0)]
|
|
||||||
[#:mutable? mutable? boolean? weak?]
|
|
||||||
[#:weak? weak? boolean? #f]
|
|
||||||
[elem any/c] ...)
|
|
||||||
set?]{
|
|
||||||
|
|
||||||
Produces a custom hash table-based set using the given equality predicate
|
|
||||||
@scheme[equiv?] and optional hash functions @scheme[hash-primary] and
|
|
||||||
@scheme[hash-secondary]. If no hash functions are given, they default to a
|
|
||||||
degenerate hash function, resulting in an effectively list-based set. The set
|
|
||||||
is populated with the given @scheme[elem] values.
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(define singularity
|
|
||||||
(custom-set 'one 'two 'three
|
|
||||||
#:mutable? #t
|
|
||||||
#:compare (lambda (a b) #t)))
|
|
||||||
(set->list singularity)
|
|
||||||
(set-insert! singularity 'four)
|
|
||||||
(set->list singularity)
|
|
||||||
(set-remove! singularity 'zero)
|
|
||||||
(set->list singularity)
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@section{Set Accessors}
|
|
||||||
|
|
||||||
@defproc[(set-contains? [s set?] [x any/c]) boolean?]{
|
|
||||||
|
|
||||||
Reports whether @scheme[s] contains @scheme[x].
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(set-contains? (set 1 2 3) 1)
|
|
||||||
(set-contains? (set 1 2 3) 4)
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(set-empty? [s set?]) boolean?]{
|
|
||||||
|
|
||||||
Reports whether a set is empty.
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(set-empty? '())
|
|
||||||
(set-empty? '((1 . one)))
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(set-count [s set?]) exact-nonnegative-integer?]{
|
|
||||||
|
|
||||||
Reports the number of elements in @scheme[s].
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(set-count (set))
|
|
||||||
(set-count (set 1 2 3))
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(set=? [a set?] [b set?]) boolean?]{
|
|
||||||
|
|
||||||
Reports whether two sets contain the same elements.
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/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[(subset? [a set?] [b set?]) boolean?]{
|
|
||||||
|
|
||||||
Reports whether @scheme[b] contains all of the elements of @scheme[a].
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(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? [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 (evaluator 'unstable/cce/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 (evaluator 'unstable/cce/set)
|
|
||||||
(set->list (set 1 2 3))
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(in-set [s set?]) sequence?]{
|
|
||||||
|
|
||||||
Produces a sequence iterating over the elements of the set.
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(for/list ([x (in-set (set 1 2 3))]) x)
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@section{Set Updaters}
|
|
||||||
|
|
||||||
@defproc[(set-insert [s set?] [x any/c]) set?]{
|
|
||||||
|
|
||||||
Produces a new version of @scheme[s] containing @scheme[x].
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(set-insert (set 1 2 3) 4)
|
|
||||||
(set-insert (set 1 2 3) 1)
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(set-remove [s set?] [x any/c]) set?]{
|
|
||||||
|
|
||||||
Produces a new version of @scheme[s] that does not contain @scheme[x].
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(set-remove (set 1 2 3) 1)
|
|
||||||
(set-remove (set 1 2 3) 4)
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(set-insert! [s set?] [x any/c]) void?]{
|
|
||||||
|
|
||||||
Mutates @scheme[s] to contain @scheme[x].
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(define s (set #:mutable? #t 1 2 3))
|
|
||||||
s
|
|
||||||
(set-insert! s 4)
|
|
||||||
s
|
|
||||||
(set-insert! s 1)
|
|
||||||
s
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(set-remove! [s set?] [x any/c]) void?]{
|
|
||||||
|
|
||||||
Mutates @scheme[x] so as not to contain @scheme[x].
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(define s (set #:mutable? #t 1 2 3))
|
|
||||||
s
|
|
||||||
(set-remove! s 1)
|
|
||||||
s
|
|
||||||
(set-remove! s 4)
|
|
||||||
s
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(set-union [s0 (and/c set? set-can-insert?)] [s set?] ...) set?]{
|
|
||||||
|
|
||||||
Produces a new version of @scheme[s0] containing all the elements in each
|
|
||||||
@scheme[s].
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(set-union (set 1 2) (set 1 3) (set 2 3))
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(set-intersection [s0 (and/c set? set-can-remove?)] [s set?] ...)
|
|
||||||
set?]{
|
|
||||||
|
|
||||||
Produces a new version of @scheme[s0] containing only those elements found in
|
|
||||||
every @scheme[s].
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(set-intersection (set 1 2 3) (set 1 2) (set 2 3))
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(set-difference [s0 (and/c set? set-can-remove?)] [s set?] ...) set?]{
|
|
||||||
|
|
||||||
Produces a new version of @scheme[s0] containing only those elements not found
|
|
||||||
in any @scheme[s].
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(set-difference (set 1 2 3) (set 1) (set 3))
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@defproc[(set-exclusive-or [s0 (and/c set? set-can-insert? set-can-remove?)]
|
|
||||||
[s set?] ...)
|
|
||||||
set?]{
|
|
||||||
|
|
||||||
Produces a new version of @scheme[s0] containing only those elements found in
|
|
||||||
@scheme[s0] and each @scheme[s] an odd number of times.
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(set-exclusive-or (set 1) (set 1 2) (set 1 2 3))
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@section{Set Predicates}
|
|
||||||
|
|
||||||
@defproc[(set? [x any/c]) boolean?]{
|
|
||||||
|
|
||||||
Recognizes sets. A @deftech{set} is either a @tech[#:doc '(lib
|
|
||||||
"scribblings/reference/reference.scrbl")]{dictionary} or a structure with the
|
|
||||||
@scheme[prop:set] property.
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(set? '(1 2))
|
|
||||||
(set? '((1 . one) (2 . two)))
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@deftogether[(
|
|
||||||
@defproc[(set-can-insert? [s set?]) boolean?]
|
|
||||||
@defproc[(set-can-remove? [s set?]) boolean?]
|
|
||||||
@defproc[(set-can-insert!? [s set?]) boolean?]
|
|
||||||
@defproc[(set-can-remove!? [s set?]) boolean?]
|
|
||||||
)]{
|
|
||||||
|
|
||||||
Report whether @scheme[s] supports @scheme[set-insert], @scheme[set-remove],
|
|
||||||
@scheme[set-insert!], or @scheme[set-remove!], respectively.
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(define functional-set (set 1 2 3))
|
|
||||||
(set-can-insert? functional-set)
|
|
||||||
(set-can-remove? functional-set)
|
|
||||||
(set-can-insert!? functional-set)
|
|
||||||
(set-can-remove!? functional-set)
|
|
||||||
(define imperative-set (set #:mutable? #t 1 2 3))
|
|
||||||
(set-can-insert? imperative-set)
|
|
||||||
(set-can-remove? imperative-set)
|
|
||||||
(set-can-insert!? imperative-set)
|
|
||||||
(set-can-remove!? imperative-set)
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
@section{Structures as Sets}
|
|
||||||
|
|
||||||
@defthing[prop:set struct-type-property?]{
|
|
||||||
|
|
||||||
Property for structurs as @tech{sets}. Its value must be a vector of 7
|
|
||||||
elements, as follows:
|
|
||||||
|
|
||||||
@itemlist[
|
|
||||||
|
|
||||||
@item{a binary function implementing @scheme[set-contains?],}
|
|
||||||
|
|
||||||
@item{a binary function implementing @scheme[set-insert!], or @scheme[#f] if not
|
|
||||||
supported,}
|
|
||||||
|
|
||||||
@item{a binary function implementing @scheme[set-insert], or @scheme[#f] if not
|
|
||||||
supported,}
|
|
||||||
|
|
||||||
@item{a binary function implementing @scheme[set-remove!], or @scheme[#f] if not
|
|
||||||
supported,}
|
|
||||||
|
|
||||||
@item{a binary function implementing @scheme[set-remove], or @scheme[#f] if
|
|
||||||
not supported,}
|
|
||||||
|
|
||||||
@item{a unary function implementing @scheme[set-count],}
|
|
||||||
|
|
||||||
@item{and a unary function implementing @scheme[in-set].}
|
|
||||||
|
|
||||||
]
|
|
||||||
|
|
||||||
@defexamples[
|
|
||||||
#:eval (evaluator 'unstable/cce/set)
|
|
||||||
(define (never-contains? set elem) #f)
|
|
||||||
(define (never-insert! set elem) (error 'set-insert! "always empty!"))
|
|
||||||
(define (never-insert set elem) (error 'set-insert "always empty!"))
|
|
||||||
(define (never-remove! set elem) (void))
|
|
||||||
(define (never-remove set elem) set)
|
|
||||||
(define (always-zero set) 0)
|
|
||||||
(define (no-elements set) null)
|
|
||||||
|
|
||||||
(define-struct always-empty []
|
|
||||||
#:transparent
|
|
||||||
#:property prop:set
|
|
||||||
(vector never-contains?
|
|
||||||
never-insert!
|
|
||||||
never-insert
|
|
||||||
never-remove!
|
|
||||||
never-remove
|
|
||||||
always-zero
|
|
||||||
no-elements))
|
|
||||||
|
|
||||||
(set? (make-always-empty))
|
|
||||||
(set-contains? (make-always-empty) 1)
|
|
||||||
(set-insert! (make-always-empty) 2)
|
|
||||||
(set-insert (make-always-empty) 3)
|
|
||||||
(set-remove (make-always-empty) 4)
|
|
||||||
(set-remove! (make-always-empty) 5)
|
|
||||||
(set-count (make-always-empty))
|
|
||||||
(for ([x (in-set (make-always-empty))])
|
|
||||||
(printf "~s\n" x))
|
|
||||||
]
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
@ -1,292 +0,0 @@
|
||||||
#lang scheme
|
|
||||||
|
|
||||||
(require unstable/dict)
|
|
||||||
|
|
||||||
;; A Set is either a Dict or a struct with the prop:set property.
|
|
||||||
;; A SetProperty is:
|
|
||||||
;; (Vector (-> Set Any Any)
|
|
||||||
;; (Or (-> Set Any Void) #f)
|
|
||||||
;; (Or (-> Set Any Set) #f)
|
|
||||||
;; (Or (-> Set Any Void) #f)
|
|
||||||
;; (Or (-> Set Any Set) #f)
|
|
||||||
;; (-> Set ExactInteger)
|
|
||||||
;; (-> Set Sequence))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;
|
|
||||||
;; Set Property
|
|
||||||
;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
;; set-property-guard : Any (List ...) -> Any
|
|
||||||
;; Protects prop:set from bad inputs.
|
|
||||||
(define (set-property-guard prop info)
|
|
||||||
(check-vector 'prop:set "property" prop 7)
|
|
||||||
(check-vector-element 'prop:set "property" prop 0
|
|
||||||
check-procedure "contains?" 2)
|
|
||||||
(check-vector-element 'prop:set "property" prop 1
|
|
||||||
check-optional "insert!" check-procedure 2)
|
|
||||||
(check-vector-element 'prop:set "property" prop 2
|
|
||||||
check-optional "insert" check-procedure 2)
|
|
||||||
(check-vector-element 'prop:set "property" prop 3
|
|
||||||
check-optional "remove!" check-procedure 2)
|
|
||||||
(check-vector-element 'prop:set "property" prop 4
|
|
||||||
check-optional "remove" check-procedure 2)
|
|
||||||
(check-vector-element 'prop:set "property" prop 5
|
|
||||||
check-procedure "count" 1)
|
|
||||||
(check-vector-element 'prop:set "property" prop 6
|
|
||||||
check-procedure "to-sequence" 1)
|
|
||||||
prop)
|
|
||||||
|
|
||||||
(define-values [ prop:set set-struct? get ]
|
|
||||||
(make-struct-type-property 'set set-property-guard))
|
|
||||||
|
|
||||||
(define (prop-contains? prop) (vector-ref prop 0))
|
|
||||||
(define (prop-insert! prop) (vector-ref prop 1))
|
|
||||||
(define (prop-insert prop) (vector-ref prop 2))
|
|
||||||
(define (prop-remove! prop) (vector-ref prop 3))
|
|
||||||
(define (prop-remove prop) (vector-ref prop 4))
|
|
||||||
(define (prop-count prop) (vector-ref prop 5))
|
|
||||||
(define (prop-to-sequence prop) (vector-ref prop 6))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;
|
|
||||||
;; Core Functions
|
|
||||||
;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(define (set? set)
|
|
||||||
(or (set-struct? set)
|
|
||||||
(dict? set)))
|
|
||||||
|
|
||||||
(define (set-can-insert? set)
|
|
||||||
(if (set-struct? set)
|
|
||||||
(procedure? (prop-insert (get set)))
|
|
||||||
(dict-can-functional-set? set)))
|
|
||||||
|
|
||||||
(define (set-can-remove? set)
|
|
||||||
(if (set-struct? set)
|
|
||||||
(procedure? (prop-remove (get set)))
|
|
||||||
(and (dict-can-functional-set? set)
|
|
||||||
(dict-can-remove-keys? set))))
|
|
||||||
|
|
||||||
(define (set-can-insert!? set)
|
|
||||||
(if (set-struct? set)
|
|
||||||
(procedure? (prop-insert! (get set)))
|
|
||||||
(dict-mutable? set)))
|
|
||||||
|
|
||||||
(define (set-can-remove!? set)
|
|
||||||
(if (set-struct? set)
|
|
||||||
(procedure? (prop-remove! (get set)))
|
|
||||||
(and (dict-mutable? set)
|
|
||||||
(dict-can-remove-keys? set))))
|
|
||||||
|
|
||||||
(define (set-contains? set x)
|
|
||||||
(if (set-struct? set)
|
|
||||||
((prop-contains? (get set)) set x)
|
|
||||||
(dict-has-key? set x)))
|
|
||||||
|
|
||||||
(define (set-insert! set x)
|
|
||||||
(if (set-struct? set)
|
|
||||||
((prop-insert! (get set)) set x)
|
|
||||||
(dict-set! set x null)))
|
|
||||||
|
|
||||||
(define (set-insert set x)
|
|
||||||
(if (set-struct? set)
|
|
||||||
((prop-insert (get set)) set x)
|
|
||||||
(dict-set set x null)))
|
|
||||||
|
|
||||||
(define (set-remove! set x)
|
|
||||||
(if (set-struct? set)
|
|
||||||
((prop-remove! (get set)) set x)
|
|
||||||
(dict-remove! set x)))
|
|
||||||
|
|
||||||
(define (set-remove set x)
|
|
||||||
(if (set-struct? set)
|
|
||||||
((prop-remove (get set)) set x)
|
|
||||||
(dict-remove set x)))
|
|
||||||
|
|
||||||
(define (set-count set)
|
|
||||||
(if (set-struct? set)
|
|
||||||
((prop-count (get set)) set)
|
|
||||||
(dict-count set)))
|
|
||||||
|
|
||||||
(define (in-set set)
|
|
||||||
(if (set-struct? set)
|
|
||||||
((prop-to-sequence (get set)) set)
|
|
||||||
(in-dict-keys set)))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;
|
|
||||||
;; Derived Functions
|
|
||||||
;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(define (set->list set)
|
|
||||||
(for/list ([elem (in-set set)]) elem))
|
|
||||||
|
|
||||||
(define (set-empty? set)
|
|
||||||
(= (set-count set) 0))
|
|
||||||
|
|
||||||
(define (set #:weak? [weak? #f]
|
|
||||||
#:mutable? [mutable? weak?]
|
|
||||||
#:compare [compare 'equal]
|
|
||||||
. elements)
|
|
||||||
(list->set elements #:mutable? mutable? #:weak? weak? #:compare compare))
|
|
||||||
|
|
||||||
(define (list->set elems
|
|
||||||
#:weak? [weak? #f]
|
|
||||||
#:mutable? [mutable? weak?]
|
|
||||||
#:compare [compare 'equal])
|
|
||||||
(make-dict (for/list ([e (in-list elems)]) (cons e null))
|
|
||||||
#:mutable? mutable? #:weak? weak? #:compare compare))
|
|
||||||
|
|
||||||
(define (empty-set #:weak? [weak? #f]
|
|
||||||
#:mutable? [mutable? weak?]
|
|
||||||
#:compare [compare 'equal])
|
|
||||||
(empty-dict #:mutable? mutable? #:weak? weak? #:compare compare))
|
|
||||||
|
|
||||||
(define (custom-set #:compare compare
|
|
||||||
#:hash [hash (lambda (x) 0)]
|
|
||||||
#:hash2 [hash2 (lambda (x) 0)]
|
|
||||||
#:weak? [weak? #f]
|
|
||||||
#:mutable? [mutable? weak?]
|
|
||||||
. elems)
|
|
||||||
(let* ([s (custom-dict compare hash hash2 #:mutable? mutable? #:weak? weak?)])
|
|
||||||
(if mutable?
|
|
||||||
(begin0 s
|
|
||||||
(for ([elem (in-list elems)]) (set-insert! s elem)))
|
|
||||||
(for/fold ([s s]) ([elem (in-list elems)])
|
|
||||||
(set-insert s elem)))))
|
|
||||||
|
|
||||||
(define (set=? one two)
|
|
||||||
(and (subset? one two)
|
|
||||||
(subset? two one)))
|
|
||||||
|
|
||||||
(define (proper-subset? one two)
|
|
||||||
(and (subset? one two)
|
|
||||||
(not (subset? two one))))
|
|
||||||
|
|
||||||
(define (subset? one two)
|
|
||||||
(for/and ([elem (in-set one)])
|
|
||||||
(set-contains? two elem)))
|
|
||||||
|
|
||||||
(define (set-union set . rest)
|
|
||||||
(for*/fold ([one set]) ([two (in-list rest)] [elem (in-set two)])
|
|
||||||
(set-insert one elem)))
|
|
||||||
|
|
||||||
(define (set-intersection set . rest)
|
|
||||||
(for*/fold ([one set]) ([two (in-list rest)] [elem (in-set one)]
|
|
||||||
#:when (not (set-contains? two elem)))
|
|
||||||
(set-remove one elem)))
|
|
||||||
|
|
||||||
(define (set-difference set . rest)
|
|
||||||
(for*/fold ([one set]) ([two (in-list rest)] [elem (in-set one)]
|
|
||||||
#:when (set-contains? two elem))
|
|
||||||
(set-remove one elem)))
|
|
||||||
|
|
||||||
(define (set-exclusive-or set . rest)
|
|
||||||
(for*/fold ([one set]) ([two (in-list rest)] [elem (in-set two)])
|
|
||||||
(if (set-contains? one elem)
|
|
||||||
(set-remove one elem)
|
|
||||||
(set-insert one elem))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;
|
|
||||||
;; Generic Checks
|
|
||||||
;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(define (check-vector caller desc value size)
|
|
||||||
(unless (vector? value)
|
|
||||||
(error caller "expected ~a to be a vector; got: ~e" desc value))
|
|
||||||
(unless (= (vector-length value) size)
|
|
||||||
(error caller
|
|
||||||
"expected ~a to have length ~a; got length ~a in: ~e"
|
|
||||||
desc size (vector-length value) value)))
|
|
||||||
|
|
||||||
(define (check-vector-element caller desc value index check part . args)
|
|
||||||
(apply check
|
|
||||||
caller
|
|
||||||
(format "~a element ~a (~a)" desc index part)
|
|
||||||
(vector-ref value index)
|
|
||||||
args))
|
|
||||||
|
|
||||||
(define (check-procedure caller desc value arity)
|
|
||||||
(unless (procedure? value)
|
|
||||||
(error caller "expected ~a to be a procedure; got: ~e" desc value))
|
|
||||||
(unless (procedure-arity-includes? value arity)
|
|
||||||
(error caller
|
|
||||||
"expected ~a to accept ~a arguments; got: ~e"
|
|
||||||
desc
|
|
||||||
arity
|
|
||||||
value)))
|
|
||||||
|
|
||||||
(define (check-optional caller desc value check . args)
|
|
||||||
(when value (apply check caller desc value args)))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;
|
|
||||||
;; Exports
|
|
||||||
;;
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(provide/contract
|
|
||||||
[set? (-> any/c boolean?)]
|
|
||||||
[set-empty? (-> any/c boolean?)]
|
|
||||||
[set
|
|
||||||
(->* []
|
|
||||||
[#:mutable? boolean? #:weak? boolean? #:compare (or/c 'eq 'eqv 'equal)]
|
|
||||||
#:rest list?
|
|
||||||
set?)]
|
|
||||||
[list->set
|
|
||||||
(->* [list?]
|
|
||||||
[#:mutable? boolean? #:weak? boolean? #:compare (or/c 'eq 'eqv 'equal)]
|
|
||||||
set?)]
|
|
||||||
[empty-set
|
|
||||||
(->* []
|
|
||||||
[#:mutable? boolean? #:weak? boolean? #:compare (or/c 'eq 'eqv 'equal)]
|
|
||||||
set?)]
|
|
||||||
[custom-set
|
|
||||||
(->* [#:compare (-> any/c any/c any/c)]
|
|
||||||
[#:hash
|
|
||||||
(-> any/c exact-integer?)
|
|
||||||
#:hash2
|
|
||||||
(-> any/c exact-integer?)
|
|
||||||
#:mutable? boolean?
|
|
||||||
#:weak? boolean?]
|
|
||||||
#:rest list?
|
|
||||||
set?)]
|
|
||||||
[set->list (-> set? list?)]
|
|
||||||
[set-contains? (-> set? any/c boolean?)]
|
|
||||||
[set-insert (-> set? any/c any/c)]
|
|
||||||
[set-remove (-> set? any/c set?)]
|
|
||||||
[set-insert! (-> set? any/c void?)]
|
|
||||||
[set-remove! (-> set? any/c void?)]
|
|
||||||
[set-can-insert? (-> set? boolean?)]
|
|
||||||
[set-can-remove? (-> set? boolean?)]
|
|
||||||
[set-can-insert!? (-> set? boolean?)]
|
|
||||||
[set-can-remove!? (-> set? boolean?)]
|
|
||||||
[set-count (-> set? exact-nonnegative-integer?)]
|
|
||||||
[in-set (-> set? sequence?)]
|
|
||||||
[set=? (-> set? set? boolean?)]
|
|
||||||
[subset? (-> set? set? boolean?)]
|
|
||||||
[proper-subset? (-> set? set? boolean?)]
|
|
||||||
[set-union
|
|
||||||
(->* [(and/c set? set-can-insert?)] []
|
|
||||||
#:rest (listof set?)
|
|
||||||
set?)]
|
|
||||||
[set-intersection
|
|
||||||
(->* [(and/c set? set-can-remove?)] []
|
|
||||||
#:rest (listof set?)
|
|
||||||
set?)]
|
|
||||||
[set-difference
|
|
||||||
(->* [(and/c set? set-can-remove?)] []
|
|
||||||
#:rest (listof set?)
|
|
||||||
set?)]
|
|
||||||
[set-exclusive-or
|
|
||||||
(->* [(and/c set? set-can-insert? set-can-remove?)] []
|
|
||||||
#:rest (listof set?)
|
|
||||||
set?)]
|
|
||||||
[prop:set struct-type-property?]
|
|
||||||
)
|
|
||||||
|
|
@ -1,10 +1,8 @@
|
||||||
#lang scheme
|
#lang scheme
|
||||||
|
|
||||||
(require "checks.ss"
|
(require "checks.ss"
|
||||||
"test-debug.ss"
|
"test-debug.ss")
|
||||||
"test-set.ss")
|
|
||||||
|
|
||||||
(run-tests
|
(run-tests
|
||||||
(test-suite "scheme.plt"
|
(test-suite "scheme.plt"
|
||||||
debug-suite
|
debug-suite))
|
||||||
set-suite))
|
|
||||||
|
|
|
||||||
|
|
@ -1,169 +0,0 @@
|
||||||
#lang scheme
|
|
||||||
|
|
||||||
(require "checks.ss"
|
|
||||||
"../set.ss")
|
|
||||||
|
|
||||||
(provide set-suite)
|
|
||||||
|
|
||||||
(define (check/set a-set a-list #:= [== equal?])
|
|
||||||
(check/sort (set->list a-set) a-list #:= ==))
|
|
||||||
|
|
||||||
(define-syntax-rule (test/set arg ...)
|
|
||||||
(test (check/set arg ...)))
|
|
||||||
|
|
||||||
(define set-suite
|
|
||||||
(test-suite "set.ss"
|
|
||||||
(test-suite "Constructors"
|
|
||||||
(test-suite "set"
|
|
||||||
(test/set (set 1 2 3) (list 1 2 3))
|
|
||||||
(test/set (set 3 2 1) (list 1 2 3))
|
|
||||||
(test/set (set 3 1 2 #:mutable? #t) (list 1 2 3))
|
|
||||||
(test/set (set 3 1 2 #:weak? #t) (list 1 2 3))
|
|
||||||
(test/set (set 3 1 2 #:compare 'eqv) (list 1 2 3))
|
|
||||||
(test/set (set 3 1 2 #:compare 'eq) (list 1 2 3)))
|
|
||||||
(test-suite "empty-set"
|
|
||||||
(test/set (empty-set) (list))
|
|
||||||
(test/set (empty-set #:mutable? #t) (list))
|
|
||||||
(test/set (empty-set #:weak? #t) (list))
|
|
||||||
(test/set (empty-set #:compare 'eqv) (list))
|
|
||||||
(test/set (empty-set #:compare 'eq) (list)))
|
|
||||||
(test-suite "list->set"
|
|
||||||
(test/set (list->set (list 1 2 3)) (list 1 2 3))
|
|
||||||
(test/set (list->set (list 3 2 1)) (list 1 2 3))
|
|
||||||
(test/set (list->set (list 3 1 2) #:mutable? #t) (list 1 2 3))
|
|
||||||
(test/set (list->set (list 3 1 2) #:weak? #t) (list 1 2 3))
|
|
||||||
(test/set (list->set (list 3 1 2) #:compare 'eqv) (list 1 2 3))
|
|
||||||
(test/set (list->set (list 3 1 2) #:compare 'eq) (list 1 2 3)))
|
|
||||||
(test-suite "custom-set"
|
|
||||||
(test/set (custom-set #:compare string-ci=? "A" "a" "B" "b")
|
|
||||||
(list "A" "B")
|
|
||||||
#:= string-ci=?)
|
|
||||||
(test/set (custom-set #:compare string-ci=?
|
|
||||||
#:hash string-length
|
|
||||||
"A" "a" "B" "b")
|
|
||||||
(list "A" "B")
|
|
||||||
#:= string-ci=?)
|
|
||||||
(test/set (custom-set #:compare string-ci=?
|
|
||||||
#:hash string-length
|
|
||||||
#:mutable? #t
|
|
||||||
"A" "a" "B" "b")
|
|
||||||
(list "A" "B")
|
|
||||||
#:= string-ci=?)))
|
|
||||||
(test-suite "Accessors"
|
|
||||||
(test-suite "set-contains?"
|
|
||||||
(test (check-true (set-contains? (set 1 2 3) 1)))
|
|
||||||
(test (check-false (set-contains? (set 1 2 3) 4))))
|
|
||||||
(test-suite "set-empty?"
|
|
||||||
(test (check-true (set-empty? (set))))
|
|
||||||
(test (check-false (set-empty? (set 1 2 3)))))
|
|
||||||
(test-suite "set-count"
|
|
||||||
(test (check = (set-count (set)) 0))
|
|
||||||
(test (check = (set-count (set 1 2 3)) 3)))
|
|
||||||
(test-suite "set=?"
|
|
||||||
(test (check-false (set=? (set 1) (set 1 2 3))))
|
|
||||||
(test (check-false (set=? (set 1 2 3) (set 1))))
|
|
||||||
(test (check-true (set=? (set 1 2 3) (set 1 2 3)))))
|
|
||||||
(test-suite "subset?"
|
|
||||||
(test (check-true (subset? (set 1) (set 1 2 3))))
|
|
||||||
(test (check-false (subset? (set 1 2 3) (set 1))))
|
|
||||||
(test (check-true (subset? (set 1 2 3) (set 1 2 3)))))
|
|
||||||
(test-suite "proper-subset?"
|
|
||||||
(test (check-true (proper-subset? (set 1) (set 1 2 3))))
|
|
||||||
(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 "set->list"
|
|
||||||
(test (check/sort (set->list (set 1 2 3)) (list 1 2 3))))
|
|
||||||
(test-suite "in-set"
|
|
||||||
(test (check/sort (for/list ([x (in-set (set 1 2 3))]) x)
|
|
||||||
(list 1 2 3)))))
|
|
||||||
(test-suite "Updaters"
|
|
||||||
(test-suite "set-insert"
|
|
||||||
(test/set (set-insert (set 1 2 3) 4) (list 1 2 3 4))
|
|
||||||
(test/set (set-insert (set 1 2 3) 1) (list 1 2 3)))
|
|
||||||
(test-suite "set-remove"
|
|
||||||
(test/set (set-remove (set 1 2 3) 1) (list 2 3))
|
|
||||||
(test/set (set-remove (set 1 2 3) 4) (list 1 2 3)))
|
|
||||||
(test-suite "set-insert!"
|
|
||||||
(test (let* ([s (set 1 2 3 #:mutable? #t)])
|
|
||||||
(set-insert! s 4)
|
|
||||||
(check/set s (list 1 2 3 4))))
|
|
||||||
(test (let* ([s (set 1 2 3 #:mutable? #t)])
|
|
||||||
(set-insert! s 1)
|
|
||||||
(check/set s (list 1 2 3)))))
|
|
||||||
(test-suite "set-remove!"
|
|
||||||
(test (let* ([s (set 1 2 3 #:mutable? #t)])
|
|
||||||
(set-remove! s 1)
|
|
||||||
(check/set s (list 2 3))))
|
|
||||||
(test (let* ([s (set 1 2 3 #:mutable? #t)])
|
|
||||||
(set-remove! s 4)
|
|
||||||
(check/set s (list 1 2 3)))))
|
|
||||||
(test-suite "set-union"
|
|
||||||
(test/set (set-union (set 1 2) (set 1 3) (set 2 3)) (list 1 2 3))
|
|
||||||
(test/set (set-union (set) (set 1 2) (set 3 4)) (list 1 2 3 4))
|
|
||||||
(test/set (set-union (set 1 2) (set) (set 3 4)) (list 1 2 3 4))
|
|
||||||
(test/set (set-union (set 1 2) (set 3 4) (set)) (list 1 2 3 4)))
|
|
||||||
(test-suite "set-intersection"
|
|
||||||
(test/set (set-intersection (set 1 2 3) (set 1 2) (set 2 3)) (list 2))
|
|
||||||
(test/set (set-intersection (set 1 2) (set 1 2 3) (set 2 3)) (list 2))
|
|
||||||
(test/set (set-intersection (set 1 2) (set 2 3) (set 1 2 3)) (list 2))
|
|
||||||
(test/set (set-intersection (set 1 2) (set 2 3) (set 1 3)) (list)))
|
|
||||||
(test-suite "set-difference"
|
|
||||||
(test/set (set-difference (set 1 2 3) (set 1) (set 3)) (list 2))
|
|
||||||
(test/set (set-difference (set 1 2 3 4) (set 5) (set 6)) (list 1 2 3 4))
|
|
||||||
(test/set (set-difference (set 1 2 3) (set 1 2) (set 2 3)) (list)))
|
|
||||||
(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 "Predicates"
|
|
||||||
(test-suite "set?"
|
|
||||||
(test (check-false (set? '(1 2))))
|
|
||||||
(test (check-true (set? '((1 . one) (2 . two)))))
|
|
||||||
(test (check-true (set? (set 1 2 3)))))
|
|
||||||
(test-suite "set-can-insert?"
|
|
||||||
(test (check-true (set-can-insert? (set 1 2 3))))
|
|
||||||
(test (check-false (set-can-insert? (set 1 2 3 #:mutable? #t)))))
|
|
||||||
(test-suite "set-can-remove?"
|
|
||||||
(test (check-true (set-can-remove? (set 1 2 3))))
|
|
||||||
(test (check-false (set-can-remove? (set 1 2 3 #:mutable? #t)))))
|
|
||||||
(test-suite "set-can-insert!?"
|
|
||||||
(test (check-false (set-can-insert!? (set 1 2 3))))
|
|
||||||
(test (check-true (set-can-insert!? (set 1 2 3 #:mutable? #t)))))
|
|
||||||
(test-suite "set-can-remove!?"
|
|
||||||
(test (check-false (set-can-remove!? (set 1 2 3))))
|
|
||||||
(test (check-true (set-can-remove!? (set 1 2 3 #:mutable? #t))))))
|
|
||||||
(test-suite "Property"
|
|
||||||
(test-suite "prop:set"
|
|
||||||
(test
|
|
||||||
(let ()
|
|
||||||
(define (never-contains? set elem) #f)
|
|
||||||
(define (never-remove! set elem) (void))
|
|
||||||
(define (never-remove set elem) set)
|
|
||||||
(define (always-zero set) 0)
|
|
||||||
(define (no-elements set) null)
|
|
||||||
|
|
||||||
(define-struct always-empty []
|
|
||||||
#:transparent
|
|
||||||
#:property prop:set
|
|
||||||
(vector never-contains?
|
|
||||||
#f
|
|
||||||
#f
|
|
||||||
never-remove!
|
|
||||||
never-remove
|
|
||||||
always-zero
|
|
||||||
no-elements))
|
|
||||||
|
|
||||||
(check-true (set? (make-always-empty)))
|
|
||||||
(check/set (make-always-empty) (list))
|
|
||||||
(check-false (set-contains? (make-always-empty) 1))
|
|
||||||
(check-bad (set-insert! (make-always-empty) 2))
|
|
||||||
(check-bad (set-insert (make-always-empty) 3))
|
|
||||||
(check/set (let* ([s (make-always-empty)])
|
|
||||||
(set-remove! s 4)
|
|
||||||
s)
|
|
||||||
(list))
|
|
||||||
(check/set (set-remove (make-always-empty) 5) (list))
|
|
||||||
(check-true (set-empty? (make-always-empty)))
|
|
||||||
(check-equal? (set->list (make-always-empty)) (list))))))))
|
|
||||||
|
|
||||||
|
|
||||||
80
collects/unstable/scribblings/set.scrbl
Normal file
80
collects/unstable/scribblings/set.scrbl
Normal file
|
|
@ -0,0 +1,80 @@
|
||||||
|
#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))
|
||||||
|
]
|
||||||
|
|
||||||
|
}
|
||||||
|
|
@ -91,6 +91,7 @@ Keep documentation and tests up to date.
|
||||||
@include-section["require.scrbl"]
|
@include-section["require.scrbl"]
|
||||||
@include-section["sandbox.scrbl"]
|
@include-section["sandbox.scrbl"]
|
||||||
@include-section["scribble.scrbl"]
|
@include-section["scribble.scrbl"]
|
||||||
|
@include-section["set.scrbl"]
|
||||||
@include-section["srcloc.scrbl"]
|
@include-section["srcloc.scrbl"]
|
||||||
@include-section["string.scrbl"]
|
@include-section["string.scrbl"]
|
||||||
@include-section["struct.scrbl"]
|
@include-section["struct.scrbl"]
|
||||||
|
|
|
||||||
43
collects/unstable/set.rkt
Normal file
43
collects/unstable/set.rkt
Normal file
|
|
@ -0,0 +1,43 @@
|
||||||
|
#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)
|
||||||
|
(and (subset? one two)
|
||||||
|
(subset? two one)))
|
||||||
|
|
||||||
|
(define (proper-subset? one two)
|
||||||
|
(and (subset? one two)
|
||||||
|
(not (subset? two one))))
|
||||||
|
|
||||||
|
(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?)])
|
||||||
Loading…
Reference in New Issue
Block a user