From 459cce23bea037686f3561dd3f967a05b61dc7cd Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Tue, 12 Apr 2011 08:48:38 -0600 Subject: [PATCH] moved contents of unstable/set to racket/set --- collects/racket/set.rkt | 83 +++++++++++++++++--- collects/racklog/lang/compiler.rkt | 3 - collects/scribblings/reference/sets.scrbl | 75 +++++++++++++++++- collects/tests/unstable/set.rkt | 10 +-- collects/unstable/scribblings/set.scrbl | 80 ------------------- collects/unstable/scribblings/unstable.scrbl | 1 - collects/unstable/set.rkt | 43 ---------- 7 files changed, 152 insertions(+), 143 deletions(-) delete mode 100644 collects/unstable/scribblings/set.scrbl delete mode 100644 collects/unstable/set.rkt diff --git a/collects/racket/set.rkt b/collects/racket/set.rkt index ef0c4cc844..3794d5e55a 100644 --- a/collects/racket/set.rkt +++ b/collects/racket/set.rkt @@ -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)) diff --git a/collects/racklog/lang/compiler.rkt b/collects/racklog/lang/compiler.rkt index ee1183597a..e335d539b6 100644 --- a/collects/racklog/lang/compiler.rkt +++ b/collects/racklog/lang/compiler.rkt @@ -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) diff --git a/collects/scribblings/reference/sets.scrbl b/collects/scribblings/reference/sets.scrbl index 92d0bd1488..a76a8d44ed 100644 --- a/collects/scribblings/reference/sets.scrbl +++ b/collects/scribblings/reference/sets.scrbl @@ -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) \ No newline at end of file +@(define i2 #'set-union) + + + diff --git a/collects/tests/unstable/set.rkt b/collects/tests/unstable/set.rkt index 33730fb3e7..d245c8f4bd 100644 --- a/collects/tests/unstable/set.rkt +++ b/collects/tests/unstable/set.rkt @@ -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)))))) diff --git a/collects/unstable/scribblings/set.scrbl b/collects/unstable/scribblings/set.scrbl deleted file mode 100644 index ee314f81b6..0000000000 --- a/collects/unstable/scribblings/set.scrbl +++ /dev/null @@ -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)) -] - -} diff --git a/collects/unstable/scribblings/unstable.scrbl b/collects/unstable/scribblings/unstable.scrbl index 1f3acf7153..94dd3a4232 100644 --- a/collects/unstable/scribblings/unstable.scrbl +++ b/collects/unstable/scribblings/unstable.scrbl @@ -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"] diff --git a/collects/unstable/set.rkt b/collects/unstable/set.rkt deleted file mode 100644 index bc5daad06d..0000000000 --- a/collects/unstable/set.rkt +++ /dev/null @@ -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?)])