1#lang racket/base 2(require (for-syntax racket/base)) 3 4;; Lightweight variant of sets 5 6(provide set seteq seteqv 7 set? 8 set-empty? 9 set-member? 10 set-count 11 set-add 12 set-remove 13 set-first 14 subset? 15 set=? 16 set-subtract 17 set-union 18 set-intersect 19 set-partition 20 set->list 21 list->set 22 list->seteq 23 for/set 24 for/seteq 25 for/seteqv 26 for*/set 27 for*/seteq 28 in-set) 29 30(define the-empty-hash #hash()) 31(define the-empty-hasheq #hasheq()) 32(define the-empty-hasheqv #hasheqv()) 33 34(define set 35 (case-lambda 36 [() the-empty-hash] 37 [l (for/fold ([s the-empty-hash]) ([e (in-list l)]) 38 (hash-set s e #t))])) 39(define seteq 40 (case-lambda 41 [() the-empty-hasheq] 42 [l (for/fold ([s the-empty-hasheq]) ([e (in-list l)]) 43 (hash-set s e #t))])) 44(define (seteqv) the-empty-hasheqv) 45 46(define (set? s) (hash? s)) 47 48(define (set-empty? s) (zero? (hash-count s))) 49(define (set-member? s e) (hash-ref s e #f)) 50(define (set-count s) (hash-count s)) 51 52(define (set-add s e) (hash-set s e #t)) 53(define (set-remove s e) (hash-remove s e)) 54(define (set-first s) (hash-iterate-key s (hash-iterate-first s))) 55 56(define-syntax in-set (make-rename-transformer #'in-immutable-hash-keys)) 57 58(define (subset? s1 s2) 59 (hash-keys-subset? s1 s2)) 60 61(define (set=? s1 s2) 62 (or (eq? s1 s2) 63 (and (= (hash-count s1) (hash-count s2)) 64 (hash-keys-subset? s1 s2)))) 65 66(define (set-subtract s1 s2) 67 (for/fold ([s1 s1]) ([k (in-set s2)]) 68 (hash-remove s1 k))) 69 70(define (set-union s1 s2) 71 (if ((set-count s1) . < . (set-count s2)) 72 (set-union s2 s1) 73 (for/fold ([s1 s1]) ([k (in-set s2)]) 74 (hash-set s1 k #t)))) 75 76(define (set-intersect s1 s2) 77 (if ((set-count s1) . < . (set-count s2)) 78 (set-intersect s2 s1) 79 (for/fold ([s s2]) ([k (in-set s2)]) 80 (if (hash-ref s1 k #f) 81 s 82 (hash-remove s k))))) 83 84(define (set-partition s pred empty-y-set empty-n-set) 85 (for/fold ([y empty-y-set] [n empty-n-set]) ([v (in-set s)]) 86 (if (pred v) 87 (values (set-add y v) n) 88 (values y (set-add n v))))) 89 90(define (set->list s) 91 (for/list ([k (in-set s)]) 92 k)) 93 94(define (list->set l) 95 (for/set ([k (in-list l)]) 96 k)) 97 98(define (list->seteq l) 99 (for/seteq ([k (in-list l)]) 100 k)) 101 102(define-syntax-rule (for/set bindings body ...) 103 (for/hash bindings (values 104 (let () 105 body ...) 106 #t))) 107 108(define-syntax-rule (for/seteq bindings body ...) 109 (for/hasheq bindings (values 110 (let () 111 body ...) 112 #t))) 113 114(define-syntax-rule (for/seteqv bindings body ...) 115 (for/hasheqv bindings (values 116 (let () 117 body ...) 118 #t))) 119 120(define-syntax-rule (for*/set bindings body ...) 121 (for*/hash bindings (values 122 (let () 123 body ...) 124 #t))) 125 126(define-syntax-rule (for*/seteq bindings body ...) 127 (for*/hasheq bindings (values 128 (let () 129 body ...) 130 #t))) 131