Creates a new empty set.

(define-struct %set (avl))

(define (set is-equal? is-less?)
  (make-%set (avl is-equal? is-less?)))

Creates a new empty set, using the is-equal? and is-less? functions from S.

(define (set-from-set S)
  (make-%set (avl-from-avl (%set-avl S))))

Returns #t, if obj is a set, #f otherwise. Note: list? is also #t for a set. This means, one will normally first check if an object has predicate set?, after which a list? check is done.

(define (set? obj)
  (%set? obj))

Returns the number of objects in a set.

(define (set-size set)
  (avl-nodes (%set-avl set)))

Returns #t, is S is empty; #f otherwise.

(define (empty-set? S)
  (= (set-size S) 0))

Adds obj to S, unless obj is already present in S. Returns S.

(define (set+ set obj)
  (let ((found #t))
    (avl-find (%set-avl set) obj (lambda () (set! found #f)))
    (if (not found)
        (avl-insert! (%set-avl set) obj))
    set))

Removes obj from S, if obj is part of S. Returns S.

(define (set- set obj)
  (begin
    (avl-remove! (%set-avl set) obj)
    set))

Converts a set to a list. All elements of the set are in the list. Although the returned list seems ordered, sets are by definition unordered. The ordering of the list cannot be relied on.

(define (set->list set)
  (let ((L '()))
    (avl-for-each (%set-avl set) (lambda (obj level) (set! L (cons obj L))))
    L))

Calls function F for all elements of S. Each element of S for which F returns #t will be part of the result set.

(define (set-filter S F)
  (let ((R (set-from-set S)))
    (avl-for-each (%set-avl S) (lambda (obj level)
                                 (if (F obj)
                                     (set+ R obj))))
    R))

Calls function F for all elements of S. Result set = S

(define (set-for-each S F)
  (avl-for-each (%set-avl S) (lambda (obj level)
                               (F obj)))
  S)

Returns #t, if obj exists in S; #f otherwise.

(define (set-exists? set obj)
  (avl-exists? (%set-avl set) obj)) 

This macro provides (naive) generic code for standard set operations. It is not used for the intersection operation, which has been optimized.

(define-syntax worker
  (syntax-rules ()
    ((_ function function1 function1-definition)
     (define (function set1 . sets)
       function1-definition
       (define (%worker set1 sets)
         (if (null? sets)
             set1
             (%worker (function1 set1 (car sets))
                     (cdr sets))))
       (%worker set1 sets)))))

This function calculates the intersection of all given sets in S. Calculating the intersection is of O(#S*n*log(n)) time, where n is the size of the first set. This function looks for the smallest set to begin with, to get n as small as possible.

This function is not thread safe for all given sets. Concurrent updating of sets during this operation will give unexpected results.

Returns a new set that is the intersection of all given sets.

(define (set-intersection . sets)

  (define (set-intersect1 set1 set2)

    (define (intersect-node avl2 obj)
      (let ((found #t))
        (avl-find avl2 obj (lambda () (set! found #f)))
        found))

    (let ((avl1 (%set-avl set1))
          (avl2 (%set-avl set2)))
      (let ((result-set (make-%set
                              (avl-filter avl1
                                          (lambda (obj level)
                                            (intersect-node avl2 obj))))))
        result-set)))

  (define (intersection set1 sets)
    (define (%worker set1 sets)
      (if (null? sets)
          set1
          (%worker (set-intersect1 set1 (car sets))
                   (cdr sets))))
    (%worker set1 sets))

  (define (find-minimum-set-size minimum sets)
    (if (null? sets)
        minimum
        (if (< (set-size (car sets)) (set-size minimum))
            (find-minimum-set-size (car sets) (cdr sets))
            (find-minimum-set-size minimum (cdr sets)))))

  (define (filter-out-minimum minimum sets)
    (if (null? sets)
        (list)
        (if (eq? (car sets) minimum)
            (filter-out-minimum minimum (cdr sets))
            (cons (car sets) (filter-out-minimum minimum (cdr sets))))))

  (if (null? sets)
      (error "set-intersection: I need at least 1 set")
      (let ((set-with-minimum-size (find-minimum-set-size (car sets) (cdr sets))))
        (intersection set-with-minimum-size (filter-out-minimum set-with-minimum-size sets)))))

This function returns a new set, which is the union of all given sets.

(worker set-union set-unite1 

        (define (set-unite1 set1 set2)
          (let ((result-set (make-%set
                                  (avl-map (%set-avl set1)
                                           (lambda (obj level) obj)))))
            (avl-for-each (%set-avl set2)
                          (lambda (obj level)
                            (set+ result-set obj)))
            result-set)))

This function calculates the difference between set1 and the car of S. After that, the difference between the resulting set and the cadr of S is calculated and so on. The last resulting set is returned.

(worker set-difference set-subtract1

        (define (set-subtract1 set1 set2)
          
          (define (subtract-node avl2 obj)
            (let ((found #t))
              (avl-find avl2 obj (lambda () (set! found #f)))
              (not found)))
          
          (let ((avl1 (%set-avl set1))
                (avl2 (%set-avl set2)))
            (let ((result-set (make-%set
                                    (avl-filter avl1
                                                (lambda (obj level)
                                                  (subtract-node avl2 obj))))))
              result-set))))