; FILE AUTOMATICALLY GENERATED!
;
; This file was automatically generated by the svnwiki-scheme-library extension.
; The authoritative source for this is:
;
;   http://wiki.freaks-unidos.net/weblogs/azul/sets
;
; Generation data:
;
;   Input revision: 17015
;   User: www-data
;   Machine: mononykus.freaks-unidos.net
;   Date: Fri Jul  9 21:33:51 2010

(module sets (make-empty-set set-copy set->list list->set set-add! set-remove! set-size set-for-each set-has-member? set-is-subset? set-union! set-union set-difference! set-difference set-intersection! set-intersection)


(import scheme chicken)
(use posix extras srfi-1 data-structures embedded-test srfi-69)

(define-record set hash)

(define make-empty-set (compose make-set make-hash-table))

(define set-copy (compose make-set hash-table-copy set-hash))

(test-group sets-conversion
  (test (let* ((a (list->set (list 0 1 2))) (b (set-copy a)))
  (set-remove! b 1)
  (set-remove! b 2)
  (list (sort (set->list a) <) (set->list b))) (list (list 0 1 2) (list 0))))

(define set->list (compose hash-table-keys set-hash))

(define (list->set l)
  (let ((result (make-empty-set)))
    (for-each (cut set-add! result <>) l)
    result))

(test-group sets-conversion
  (test (let ((a (list->set (iota 10))))
  (set-size a)) 10)
  (test (sort (set->list (list->set (iota 10))) <) (iota 10)))

(define (set-add! a elt) (hash-table-set! (set-hash a) elt #t))
(define (set-remove! a elt) (hash-table-delete! (set-hash a) elt))

(define set-size (compose hash-table-size set-hash))

(test-group sets-size
  (test (let ((a (list->set (list 0 1 2))))
  (set-add! a 1)
  (set-add! a 1)
  (set-add! a 1)
  (set-remove! a 2)
  (sort (set->list a) <)) (list 0 1)))

(define (set-for-each proc set)
  (hash-table-walk
    (set-hash set)
    (lambda (key _)
      (proc key))))

(test-group sets-for-each
  (test (let ((a (list->set (iota 10))) (sum 0))
  (set-for-each (lambda (elt) (set! sum (+ sum elt))) a)
  sum) (apply + (iota 10))))

(define (set-has-member? a elt)
  (hash-table-ref/default (set-hash a) elt #f))

(test-group sets-has-member
  (test (not (set-has-member? (make-empty-set) 0)))
  (test (let ((a (list->set (list 0))))
  (and (set-has-member? a 0)
       (not (set-has-member? a 1))))))

(define (set-is-subset? subset a)
  (call-with-current-continuation
    (lambda (return)
      (set-for-each
        (lambda (elt) (unless (set-has-member? a elt) (return #f)))
        subset)
      (return #t))))

(define (set-is-proper-subset? subset a)
  (and (set-is-subset? subset a)
       (not (set-is-subset? a subset))))

(test-group sets-is-subset
  (test (let ((a (make-empty-set)) (b (make-empty-set)))
  (set-add! a 0)
  (set-add! a 1)
  (set-add! b 0)
  (set-add! b 1)
  (set-add! b 2)
  (and (set-is-subset? (make-empty-set) a)
       (set-is-subset? (make-empty-set) (make-empty-set))
       (not (set-is-subset? a (make-empty-set)))
       (set-is-subset? a b)
       (not (set-is-subset? b a))
       (set-is-proper-subset? a b)
       (set-is-subset? b b)
       (not (set-is-proper-subset? b b))))))

(define (set-equal? a b)
  (and (set-is-subset? a b) (set-is-subset? b a)))

(define (set-union! a b)
  (set-for-each (lambda (elt) (set-add! a elt)) b))

(define (set-union a b)
  (let ((result (set-copy a)))
    (set-union! result b)
    result))

(test-group sets-union
  (test (let ((a (list->set (list 0 1 2))) (b (list->set (list 0 3 4))))
  (sort (set->list (set-union a b)) <)) (list 0 1 2 3 4))
  (test (let ((a (list->set (list 0 1 2))) (b (list->set (list 0 3 4))))
  (set-union! a b)
  (sort (set->list a) <)) (list 0 1 2 3 4)))

(define (set-difference! a b)
  (set-for-each (lambda (elt) (set-remove! a elt)) b))

(define (set-difference a b)
  (let ((result (make-empty-set)))
    (set-for-each
      (lambda (elt)
        (unless (set-has-member? b elt)
          (set-add! result elt)))
      a)
    result))

(test-group sets-difference
  (test (let ((a (list->set (list 0 1 2))) (b (list->set (list 0 3 4))))
  (sort (set->list (set-difference a b)) <)) (list 1 2))
  (test (let ((a (list->set (list 0 1 2))) (b (list->set (list 0 3 4))))
  (set-difference! a b)
  (sort (set->list a) <)) (list 1 2)))

(define (set-intersection! a b)
  (set-difference! a (set-difference a b)))

(define (set-intersection a b)
  (let ((result (make-empty-set)))
    (set-for-each
      (lambda (elt)
        (when (set-has-member? b elt)
          (set-add! result elt)))
      a)
    result))

(test-group sets-intersection
  (test (let ((a (list->set (list 0 1 2))) (b (list->set (list 0 3 4))))
  (set->list (set-intersection a b))) (list 0))
  (test (let ((a (list->set (list 0 1 2))) (b (list->set (list 0 3 4))))
  (set-intersection! a b)
  (set->list a)) (list 0)))

); close module expr