diff --git a/src/util-set-list.scm b/src/util-set-list.scm index 5398354..22551f4 100644 --- a/src/util-set-list.scm +++ b/src/util-set-list.scm @@ -30,24 +30,25 @@ ( TAG-LSET - ;;make-lset - ;;lset-add - ;;lset-remove + make-lset + lset-add + lset-remove - ;;lset-member? + lset-member? - ;;lset-merge - ;;lset-intersect - ;;lset-subtract + list->lset + lset->list - ;;list->lset - ;;lset->list + lset-merge + lset-intersect + lset-subtract ) (import scheme (chicken string) (chicken random)) + ;; Tag used for identifying list sets from this module (define TAG-LSET (string-intersperse (cons "LSET-" @@ -62,8 +63,106 @@ (make-string 8))))) "")) + ;; Creates new list set using given equality procedure + (define (make-lset equality?) + (list TAG-LSET + (list equality?))) + + ;; Convenience accessors + (define lset-meta cadr) + (define lset-equality? caadr) + (define lset-list cddr) + + ;; Returns true if given element is in the list + (define (lset-member? ls el) + (let ((equality? (lset-equality? ls))) + (let loop ((els (lset-list ls))) + (if (null? els) + #f + (if (equality? (car els) el) + #t + (loop (cdr els))))))) + + ;; Adds given element to the list set + (define (lset-add ls el) + (if (lset-member? ls el) + ls + (cons TAG-LSET + (cons (lset-meta ls) + (cons el + (lset-list ls)))))) + + ;; Remove given element from the set + (define (lset-remove ls el) + (let ((equality? (lset-equality? ls))) + (let loop ((els (lset-list ls)) + (res '())) + (if (null? els) + (cons TAG-LSET + (cons (lset-meta ls) + res)) + (loop (cdr els) + (if (equality? (car els) el) + res + (cons (car els) res))))))) + + ;; Converts given list to a set with unique members + (define (list->lset lst equality?) + (let loop ((lst lst) + (ls (make-lset equality?))) + (if (null? lst) + ls + (loop (cdr lst) + (lset-add ls (car lst)))))) + + ;; Converts the list set to plain list (effectively returning the + ;; internal list) + (define lset->list lset-list) + + ;; Merges two (compatible) list sets + (define (lset-merge ls1 ls2) + (let loop ((lst (lset-list ls2)) + (ls ls1)) + (if (null? lst) + ls + (loop (cdr lst) + (lset-add ls (car lst)))))) + + ;; Returns list set intersection (set of elements in both sets) + (define (lset-intersect ls1 ls2) + (let loop ((lst (lset-list ls2)) + (ls (make-lset (lset-equality? ls1)))) + (if (null? lst) + ls + (let ((el (car lst))) + (loop (cdr lst) + (if (lset-member? ls1 el) + (lset-add ls el) + ls)))))) + + ;; Returns the set ls1 without elements in ls2 + (define (lset-subtract ls1 ls2) + (let loop ((lst (lset-list ls2)) + (ls ls1)) + (if (null? lst) + ls + (loop (cdr lst) + (lset-remove ls (car lst)))))) + ) (import util-set-list) (print TAG-LSET) +(print (make-lset string=?)) +(define ls (make-lset string=?)) +(print ls) +(define ls1 (lset-add ls "a")) +(print ls1) +(define ls2 (lset-add ls1 "a")) +(print ls2) +(define ls3 (lset-add ls2 "b")) +(print ls3) +(define ls4 (lset-remove ls3 "a")) +(print ls4) +(print (list->lset '("asdf" "qwer" "asdf" "xcvv" "asdf" "qwer" "lkjh") string=?))