fantasy-vacation-planner/lib/set.scm

;; Implements set functionatlity using hash tables.

(library (lib set)
  (export make-set
          list->set
          set->list
          set-add!
          set-remove!
          set-in?
          set-union)
  (import
    ;; (except (rnrs base) let-values)
    (rnrs base)
    (only (guile) lambda* λ)
    ;; list procs
    (srfi srfi-1)
    ;; basic hash tables
    (srfi srfi-69)))


(define set-add!
  (lambda* (set . items)
    (let next ([items items])
      (cond
       [(null? items) set]
       [else
        (hash-table-set! set (first items) #t)
        (next (cdr items))]))))


(define set-remove!
  (λ (set item)
    (hash-table-delete! set item)))


(define set-in?
  (λ (set item)
    (hash-table-ref set item (λ () #f))))


(define make-set
  (lambda* (items #:key (equal-proc equal?))
    "Make a set of the given list of items."
    (let ([set (make-hash-table equal-proc)])
      (let next ([rem-items items])
        (cond
         [(null? rem-items) set]
         [else
          (set-add! set (first rem-items))
          (next (cdr rem-items))])))))


(define set-binary-union
  (λ (A B)
    (let ([result-set (make-set '())])
      (hash-table-walk A (λ (key val) (set-add! result-set key)))
      (hash-table-walk B (λ (key val) (set-add! result-set key)))
      result-set)))


(define set-union
  (λ (. sets)
    "caveat: this procedure is not efficient, because it creates temporary sets,
but it is pure, in that it does not modify its arguments and is referentially
transparent"
    (fold (λ (set accumulated) (set-binary-union accumulated set))
          (make-set '())
          sets)))


(define list->set
  (λ (lst)
    (make-set lst #:equal-proc equal?)))


(define set->list
  (λ (A)
    (hash-table-keys A)))