#| Copyright 2024 Peter McGoron
 |
 | Licensed under the Apache License, Version 2.0 (the "License");
 | you may not use this file except in compliance with the License.
 | You may obtain a copy of the License at
 |
 |     http://www.apache.org/licenses/LICENSE-2.0
 |
 | Unless required by applicable law or agreed to in writing, software
 | distributed under the License is distributed on an "AS IS" BASIS,
 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 | See the License for the specific language governing permissions and
 | limitations under the License.
 |#

(define (orderable-generator)
  ;; Return a value that can be ordered in an obvious way.
  (gsampling (boolean-generator)
             (real-generator)
             (char-generator)
             (string-generator)
             (bytevector-generator)))

(define (remove-duplicates generator)
  ;; Remove duplicates (according to the default comparator) from vectors
  ;; made by `generator`.
  (gmap (lambda (vec)
          (let* ((cmp (make-default-comparator))
                 (table (make-hash-table (cut =? cmp <> <>) hash-by-identity))
                 (n 0))
            (vector-for-each
             (lambda (value)
               (when (hash-table-ref/default table value #f)
                 (hash-table-set! table value #t)
                 (set! n (+ n 1))))
             vec)
            (let ((new-vec (make-vector n))
                  (n 0))
              (hash-table-walk table
                               (lambda (key _)
                                 (vector-set! new-vec n key)
                                 (set! n (+ n 1))))
              new-vec)))
        generator))

(define (%set . elements)
  (apply set (make-default-comparator) elements))

;;; ;;;;;;;;;;;;;;;;;;;;
;;; Tests
;;; ;;;;;;;;;;;;;;;;;;;;

(test-group "set-empty?"
  (test-assert "empty" (set-empty? (%set)))
  (test-assert "not empty 1" (not (set-empty? (%set 0))))
  (test-assert "not empty 2" (not (set-empty? (%set 0 1))))
  (test-assert "not empty 3" (not (set-empty? (%set 0 1 2))))
  (test-assert "not empty 4" (not (set-empty? (%set 0 1 2 3)))))

(test-group "lengths"
  (test-call "0" (= 0 (set-size (%set))))
  (test-call "1" (= 1 (set-size (%set 0))))
  (test-call "2" (= 2 (set-size (%set 0 1))))
  (test-call "3" (= 3 (set-size (%set 0 1 2))))
  (test-call "4" (= 4 (set-size (%set 0 1 2 3)))))

(test-group "set->list"
  (test-call "empty" (eq? '() (set->list (%set))))
  (test-call "1" (lset= = '(1) (set->list (%set 1))))
  (test-call "2" (lset= = '(1 2) (set->list (%set 1 2))))
  (test-call "3" (lset= = '(0 1 2) (set->list (%set 0 1 2))))
  (test-call "4" (lset= = '(0 1 2 3) (set->list (%set 0 1 2 3)))))

(define (test-create-with-duplicates creator)
  (lambda (vec)
    (let* ((lst (vector->list vec))
           (new-set (creator lst))
           (set-as-list (set->list new-set)))
      (test-assert "set?" (set? new-set))
      (if (null? lst)
          (test-assert "empty?" (set-empty? new-set))
          (test-assert "empty?" (not (set-empty? new-set))))
      ;; The new-set will remove duplicates.
      (test-call "length?" (<= (set-size new-set) (length lst)))
      (test-call "subset of inserted" (lset<= equal? set-as-list lst)))))

(test-group "multiple element set using `list->set` procedure"
  (test-property (test-create-with-duplicates
                  (cute list->set (make-default-comparator) <>))
                 (list (vector-generator-of (orderable-generator)))))

(test-group "multiple element set using `set` procedure"
  (test-property (test-create-with-duplicates
                  (cute apply set (make-default-comparator) <...>))
                 (list (vector-generator-of (orderable-generator)))))

(test-group "multiple element set using `set-unfold` procedure"
  (test-property (test-create-with-duplicates
                  (cute set-unfold
                        (make-default-comparator)
                        null?
                        car
                        cdr
                        <>))
                 (list (vector-generator-of (orderable-generator)))))

(define (test-create-without-duplicates creator)
  (lambda (vec)
    (let* ((lst (vector->list vec))
           (new-set (creator lst))
           (set-as-list (set->list new-set)))
      (test-assert "set?" (set? new-set))
      (test-assert "empty?" (if (null? lst)
                                (set-empty? new-set)
                                (not (set-empty? new-set))))
      (test-equal "length?" (set-size new-set) (length lst))
      (test-call "exactly inserted" (lset= equal? set-as-list lst)))))

(test-group "multiple element set using `list->set` procedure, unique elements"
  (test-property (test-create-without-duplicates
                  (cute list->set (make-default-comparator) <>))
                 (list (remove-duplicates
                        (vector-generator-of
                         (orderable-generator))))))

(test-group "multiple element set using `set` procedure, unique elements"
  (test-property (test-create-without-duplicates
                  (cute apply set (make-default-comparator) <...>))
                 (list (remove-duplicates
                        (vector-generator-of
                         (orderable-generator))))))

(test-group "multiple element set using `set-unfold` procedure, unique elements"
  (test-property (test-create-without-duplicates
                  (cute set-unfold
                        (make-default-comparator)
                        null?
                        car
                        cdr
                        <>))
                 (list (remove-duplicates
                        (vector-generator-of
                         (orderable-generator))))))

;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Set-contains
;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;