(module sets mzscheme
	(provide set
		 set+
		 set-
		 set-intersection
		 set-union
		 set-difference
		 set-size
		 empty-set?
		 set->list
		 set-exists?
		 set-filter
		 set-for-each
		 set?)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;=head1 Sets
;;;
;;;This module provides a thread safe sets implementation. It is build
;;;upon L<AVL Trees|scheme datastructures - AVL Tree>.
;;;
;;;=verbatim scm,8
(require "avl.scm")
;;;=verbatim
;;;
;;;Being build upon AVL trees, this implementation requires
;;;both an 'is-equal?' and an 'is-less?' function to be able
;;;to work. This is a requirement that is normally quite easily
;;;fullfilled.
;;;
;;;=head2 On thread safety
;;;
;;;Although the basic operations on sets are thread safe,
;;;combining multiple sets into one operation, e.g.
;;;a set-intersection, will not guarantee thread safety for
;;;all sets.
;;;
;;;In general, thread safety of sets builds on the thread safety of the
;;;avl trees.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;=head2 Basic set functions
;;;
;;;=head3 C<(set is-equal? is-less?) : new set>
;;;
;;;Creates a new empty set.
;;;
;;;=verbatim scm,8
(define-struct %set (avl))

(define (set is-equal? is-less?)
  (make-%set (avl is-equal? is-less?)))
;;;=verbatim
;;;
;;;=head3 C<(set-from-set S:set) : new set>
;;;
;;;Creates a new empty set, using the is-equal? and is-less? functions
;;;from S.
;;;
;;;=verbatim scm,8
(define (set-from-set S)
  (make-%set (avl-from-avl (%set-avl S))))

;;;=verbatim
;;;
;;;=head3 C<(set? obj) : boolean>
;;;
;;;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.
;;;
;;;=verbatim scm,8
(define (set? obj)
  (%set? obj))

;;;=verbatim
;;;
;;;=head3 C<(set-size S:set) : number>
;;;
;;;Returns the number of objects in a set.
;;;
;;;=verbatim scm,8
(define (set-size set)
  (avl-nodes (%set-avl set)))
;;;=verbatim
;;;
;;;=head3 C<(emtpy-set? S:set) : boolean>
;;;
;;;Returns #t, is S is empty; #f otherwise.
;;;
;;;=verbatim scm,8
(define (empty-set? S)
  (= (set-size S) 0))
;;;=verbatim
;;;
;;;=head3 C<(set+ S:set obj) : set (=S)>
;;;
;;;Adds obj to S, unless obj is already present in S.
;;;Returns S.
;;;
;;;=verbatim scm,8
(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))
;;;=verbatim
;;;
;;;=head3 C<(set- S:set obj) : set (=S)>
;;;
;;;Removes obj from S, if obj is part of S.
;;;Returns S.
;;;
;;;=verbatim scm,8
(define (set- set obj)
  (begin
    (avl-remove! (%set-avl set) obj)
    set))
;;;=verbatim
;;;
;;;=head3 C<(set-E<gt>list? S:set) : list>
;;;
;;;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.
;;;
;;;=verbatim scm,8
(define (set->list set)
  (let ((L '()))
    (avl-for-each (%set-avl set) (lambda (obj level) (set! L (cons obj L))))
    L))
;;;=verbatim
;;;
;;;=head3 C<(set-filter S:set function F:boolean) : set>
;;;
;;;Calls function F for all elements of S. Each element
;;;of S for which F returns #t will be part of the result
;;;set.
;;;
;;;=verbatim scm,8
(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))
;;;=verbatim
;;;
;;;=head3 C<(set-for-each S:set function F:boolean) : S>
;;;
;;;Calls function F for all elements of S. Result set = S
;;;
;;;=verbatim scm,8
(define (set-for-each S F)
  (avl-for-each (%set-avl S) (lambda (obj level)
			       (F obj)))
  S)
;;;=verbatim
;;;
;;;=head3 C<(set-exists? S:set obj) : boolean>
;;;
;;;Returns #t, if obj exists in S; #f otherwise.
;;;
;;;=verbatim scm,8
(define (set-exists? set obj)
  (avl-exists? (%set-avl set) obj)) 
;;;=verbatim
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;=head2 Set operations
;;;
;;;=head3 Supportive macro to define set operations
;;;
;;;This macro provides (naive) generic code for standard set
;;;operations. It is not used for the intersection operation,
;;;which has been optimized.
;;;
;;;=verbatim scm,8
(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)))))
;;;=verbatim
;;;
;;;=head3 C<(set-intersection . S:list of 1 or more objects with predicate set?) : new set>
;;;
;;;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.
;;;
;;;=verbatim scm,8
(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)))))
;;;=verbatim
;;;
;;;=head3 C<(set-union set1:set . S:list of 0 or more objects with predicate set?) : new set>
;;;
;;;This function returns a new set, which is the union
;;;of all given sets.
;;;
;;;=verbatim scm,8
(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)))
;;;=verbatim
;;;
;;;=head3 C<(set-difference set1:set . S:list of 0 or more objects with predicate set?) : new 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.
;;;
;;;=verbatim scm,8
(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))))
;;;=verbatim
;;;
;;;=head2 Info
;;;
;;;S<C<Author(s):>> Hans Oesterholt (hansatelementalprogrammingdotorgextension).E<lb>
;;;S<C<Copyright:>> (c) 2005.E<lb>
;;;S<C<License  :>> L<Elemental Programming License|http://www.elemental-programming.org/epwiki/ep_license.html>.E<lb>
;;;S<C<File     :>> sets.scm $Revision: 1.2 $
;;;
;;;=cut
)