; sets implementation, using lists.
; - value equality based on eq? by default, uses equal? if given the 'equal flag
; - raises exn:set:value-not-found if value not in set when trying
;   to remove a value.
; - raise exn:set:duplicate-value by default when trying to add a value to a
;   set where it already exists
; - strange things might happen if you use set-union, set-intersection,
;   or set-difference with two sets that don't use the same comparaison
;   function: you might end up with duplicate values in some sets.
;
; Note: lots of set! and tail-recursive loops in this code, for speed

(module set-list (lib "mrflow.ss" "mrflow")
  (require
   (lib "list.ss") ; for foldr
   (lib "etc.ss") ; for opt-lambda
   "set-exn.ss" ; no prefix so we can re-provide
   )
  
  ; table = (listof (cons value value))
  (define-struct set (=? cardinality table))
  
  (provide/contract
   (exn:set? (any/c . -> . boolean?))
   (struct (exn:set:value-not-found exn:set) ((message (and/c string? immutable?))
                                              (continuation-mark-set continuation-mark-set?)
                                              (set set?)
                                              (value any/c)))
   (struct (exn:set:duplicate-value exn:set) ((message (and/c string? immutable?))
                                              (continuation-mark-set continuation-mark-set?)
                                              (set set?)
                                              (value any/c)))
   (set-make (() ((symbols 'equal)) . opt-> . set?))
   (set-reset (set? . -> . set?))
   (set? (any/c . -> . boolean?))
   (set-set ((set? any/c) (boolean?) . opt-> . set?))
   (set-in? (set? any/c . -> . boolean?))
   (set-remove ((set? any/c) (boolean?) . opt-> . set?))
   (set-cardinality (set? . -> . non-negative-exact-integer?))
   (set-empty? (set? . -> . boolean?))
   (set-copy (set? . -> . set?))
   (set-map (set? (any/c . -> . any) . -> . (listof any/c)))
   (set-fold (set? (any/c any/c . -> . any) any/c . -> . any))
   (set-for-each (set? (any/c . -> . any) . -> . set?))
   (set-for-each! (set? (any/c . -> . any) . -> . set?))
   (set-filter ((set? (any/c . -> . boolean?)) ((symbols 'new 'same)) . opt-> . set?))
   (set-union ((set? set?) ((symbols 'new 'first 'second)) . opt-> . set?))
   (set-intersection ((set? set?) ((symbols 'new 'first 'second)) . opt-> . set?))
   (set-difference ((set? set?) ((symbols 'new 'first 'second)) . opt-> . set?))
   )
  
  ; (opt 'equal) -> set
  ; we test the optional argument ourselves to preserve data abstraction even in the
  ; presence of an exception
  (define set-make
    (case-lambda
      [() (make-set eq? 0 '())]
      [(flag) (make-set equal? 0 '())]))
  
  ; set -> set
  ; doesn't change =?
  (define (set-reset set)
    (set-set-table! set '())
    (set-set-cardinality! set 0)
    set)
  
  ; value -> boolean
  ; set? comes from the structure definition
  
  ; set value (opt boolean) -> set
  (define set-set
    (opt-lambda (set value (exn? #t))
      (let ([=? (set-=? set)]
            [original-table (set-table set)])
        (set-set-table! set (let loop ([table original-table])
                              (if (null? table)
                                  (begin
                                    (set-set-cardinality! set (add1 (set-cardinality set)))
                                    (cons value original-table))
                                  (if (=? (car table) value)
                                      (if exn?
                                          (raise-duplicate-value-exn "set-set" set value)
                                          ; silently ignore
                                          original-table)
                                      (loop (cdr table)))))))
      set))
  
  ; set value -> boolean
  (define (set-in? set value)
    (let ([=? (set-=? set)])
      (ormap (lambda (current-value)
               (=? current-value value))
             (set-table set))))
  
  ; set value (opt boolean) -> set
  (define set-remove
    (opt-lambda (set value (exn? #t))
      (let ([=? (set-=? set)]
            [original-table (set-table set)])
        (set-set-table! set
                        (let loop ([table original-table]
                                   [previous #f])
                          (if (null? table)
                              (if exn?
                                  (raise-value-not-found-exn "set-remove" set value)
                                  ; silently ignore
                                  original-table)
                              (if (=? (car table) value)
                                  (begin
                                    (set-set-cardinality! set (sub1 (set-cardinality set)))
                                    (if previous
                                        (begin
                                          ; return shortened table
                                          (set-cdr! previous (cdr table))
                                          original-table)
                                        (cdr original-table)))
                                  (loop (cdr table) table))))))
      set))
  
  ; set -> exact-non-negative-integer
  ; set-cardinality comes from the structure definition
  
  ; set -> boolean
  (define (set-empty? set)
    (= 0 (set-cardinality set)))
  
  ; (listof value) (listof value) -> (listof value)
  ; creates a (reversed) copy of l1 (to prevent list sharing between sets) and prefixes l2 with it
  (define (copy-reverse-and-prefix-lists l1 l2)
    (let loop ([l1 l1]
               [l2 l2])
      (if (null? l1)
          l2
          (loop (cdr l1) (cons (car l1) l2)))))
  
  ; (listof value) -> (listof value)
  (define (copy-list l)
    (copy-reverse-and-prefix-lists l '()))
  
  ; set -> set
  (define (set-copy set)
    (make-set (set-=? set)
              (set-cardinality set)
              (copy-list (set-table set))))
  
  ; set (value -> value) -> (listof value)
  (define (set-map set f)
    (map f (set-table set)))
  
  ; set (value value -> value) value -> value
  (define (set-fold set f acc)
    (foldr f acc (set-table set)))
  
  ; set (value -> value) -> set
  (define (set-for-each set f)
    (for-each f (set-table set))
    set)
  
  ; set (value -> value) -> set
  ; it's up to the user to make sure f is injective. Otherwise we might end up with
  ; duplicates in the set.
  ; we know lists are never shared between sets, so we can set-cdr!
  (define (set-for-each! set f)
    (let loop ([table (set-table set)])
      (unless (null? table)
        (set-car! table (f (car table)))
        (loop (cdr table))))
    set)
  
  ; set (value -> boolean) (opt (union 'new 'same)) -> set
  (define set-filter
    (let (; set (value -> boolean) -> set
          [filter-into-new-set
           (lambda (set tester)
             (let loop ([table (set-table set)]
                        [new-table '()]
                        [count 0])
               (if (null? table)
                   (make-set (set-=? set) count new-table)
                   (let ([value (car table)])
                     (if (tester value)
                         (loop (cdr table) (cons value new-table) (add1 count))
                         (loop (cdr table) new-table count))))))])
      (opt-lambda (set tester (which-set 'new))
        (let ([new-set (filter-into-new-set set tester)])
          (case which-set
            [(new) new-set]
            [(same)
             (set-set-table! set (set-table new-set))
             (set-set-cardinality! set (set-cardinality new-set))
             set])))))
  
  ; set set (opt (union 'new 'first 'second)) -> set
  (define set-union
    (opt-lambda (set1 set2 (which-set 'new))
      (let* ([=? (set-=? set1)]
             [new-set
              (let loop ([table1 (set-table set1)]
                         ; we shouldn't modify the original list
                         [table2 (copy-list (set-table set2))]
                         [count1 (set-cardinality set1)]
                         [count2 (set-cardinality set2)]
                         [acc '()]
                         [count 0])
                (if (null? table1)
                    ; we have already copied table2, so we can destructively modify it
                    (make-set =? (+ count count2)
                              (append! table2 acc))
                    (if (null? table2)
                        (make-set =? (+ count count1)
                                  (copy-reverse-and-prefix-lists table1 acc))
                        (let ([value1 (car table1)])
                          ; search table2 for same value
                          (let loop-set2 ([t2 table2]
                                          [previous #f])
                            (if (null? t2)
                                (begin
                                  (set! acc (cons value1 acc))
                                  (set! count (add1 count))
                                  (set! table1 (cdr table1))
                                  (set! count1 (sub1 count1)))
                                (if (=? value1 (car t2))
                                    (begin
                                      (set! acc (cons value1 acc))
                                      (set! count (add1 count))
                                      (set! table1 (cdr table1))
                                      (set! count1 (sub1 count1))
                                      (if previous
                                          (set-cdr! previous (cdr t2))
                                          (set! table2 (cdr table2)))
                                      (set! count2 (sub1 count2)))
                                    (loop-set2 (cdr t2) t2))))
                          (loop table1 table2 count1 count2 acc count)))))])
        (case which-set
          [(new) new-set]
          [(first)
           (set-set-cardinality! set1 (set-cardinality new-set))
           (set-set-table! set1 (set-table new-set))
           set1]
          [(second)
           (set-set-cardinality! set2 (set-cardinality new-set))
           (set-set-table! set2 (set-table new-set))
           set2]))))
  
  ; set set (opt (union 'new 'first 'second)) -> set
  (define set-intersection
    (opt-lambda (set1 set2 (which-set 'new))
      (let* ([=? (set-=? set1)]
             [new-set
              (let loop ([table1 (set-table set1)]
                         ; we shouldn't modify the original list
                         [table2 (copy-list (set-table set2))]
                         [count1 (set-cardinality set1)]
                         [count2 (set-cardinality set2)]
                         [acc '()]
                         [count 0])
                (if (null? table1)
                    (make-set =? count acc)
                    (if (null? table2)
                        (make-set =? count acc)
                        (let ([value1 (car table1)])
                          ; search table2 for same value
                          (let loop-set2 ([t2 table2]
                                          [previous #f])
                            (if (null? t2)
                                (begin
                                  (set! table1 (cdr table1))
                                  (set! count1 (sub1 count1)))
                                (if (=? value1 (car t2))
                                    (begin
                                      (set! acc (cons value1 acc))
                                      (set! count (add1 count))
                                      (set! table1 (cdr table1))
                                      (set! count1 (sub1 count1))
                                      (if previous
                                          (set-cdr! previous (cdr t2))
                                          (set! table2 (cdr table2)))
                                      (set! count2 (sub1 count2)))
                                    (loop-set2 (cdr t2) t2))))
                          (loop table1 table2 count1 count2 acc count)))))])
        (case which-set
          [(new) new-set]
          [(first)
           (set-set-cardinality! set1 (set-cardinality new-set))
           (set-set-table! set1 (set-table new-set))
           set1]
          [(second)
           (set-set-cardinality! set2 (set-cardinality new-set))
           (set-set-table! set2 (set-table new-set))
           set2]))))
  
  ; set set (opt (union 'new 'first 'second)) -> set
  (define set-difference
    (opt-lambda (set1 set2 (which-set 'new))
      (let* ([=? (set-=? set1)]
             [new-set
              (let loop ([table1 (set-table set1)]
                         ; we shouldn't modify the original list
                         [table2 (copy-list (set-table set2))]
                         [count1 (set-cardinality set1)]
                         [count2 (set-cardinality set2)]
                         [acc '()]
                         [count 0])
                (if (null? table1)
                    (make-set =? count acc)
                    (if (null? table2)
                        (make-set =? (+ count count1)
                                  (copy-reverse-and-prefix-lists table1 acc))
                        (let ([value1 (car table1)])
                          ; search table2 for same value
                          (let loop-set2 ([t2 table2]
                                          [previous #f])
                            (if (null? t2)
                                (begin
                                  (set! acc (cons value1 acc))
                                  (set! count (add1 count))
                                  (set! table1 (cdr table1))
                                  (set! count1 (sub1 count1)))
                                (if (=? value1 (car t2))
                                    (begin
                                      (set! table1 (cdr table1))
                                      (set! count1 (sub1 count1))
                                      (if previous
                                          (set-cdr! previous (cdr t2))
                                          (set! table2 (cdr table2)))
                                      (set! count2 (sub1 count2)))
                                    (loop-set2 (cdr t2) t2))))
                          (loop table1 table2 count1 count2 acc count)))))])
        (case which-set
          [(new) new-set]
          [(first)
           (set-set-cardinality! set1 (set-cardinality new-set))
           (set-set-table! set1 (set-table new-set))
           set1]
          [(second)
           (set-set-cardinality! set2 (set-cardinality new-set))
           (set-set-table! set2 (set-table new-set))
           set2]))))
  
  )