Loading src/code/list.lisp +56 −11 Original line number Diff line number Diff line Loading @@ -45,7 +45,7 @@ tree-equal list-length nth %setnth nthcdr last make-list append copy-list copy-alist copy-tree revappend nconc nreconc butlast nbutlast ldiff member member-if member-if-not tailp adjoin union nunion intersection nintersection set-difference nset-difference nunion intersection nintersection nset-difference set-exclusive-or nset-exclusive-or subsetp acons pairlis assoc assoc-if assoc-if-not rassoc rassoc-if rassoc-if-not subst subst-if subst-if-not nsubst nsubst-if nsubst-if-not sublis nsublis)) Loading Loading @@ -744,6 +744,39 @@ list (cons item list))) ;; The minimum length of a list before we can use a hashtable. This ;; was determined experimentally. (defparameter *min-list-length-for-hashtable* 15) ;; Convert a list to a hashtable. The hashtable does not handle ;; duplicated values in the list. Returns the hashtable. (defun list-to-hashtable (list key test test-not) ;; Don't currently support test-not when converting a list to a hashtable (unless test-not (let ((hash-test (let ((test-fn (if (and (symbolp test) (fboundp test)) (fdefinition test) test))) (cond ((eql test-fn #'eq) 'eq) ((eql test-fn #'eql) 'eql) ((eql test-fn #'equal) 'equal) ((eql test-fn #'equalp) 'equalp))))) (unless hash-test (return-from list-to-hashtable nil)) ;; If the list is too short, the hashtable makes things ;; slower. We also need to balance memory usage. (let ((len 0)) ;; Compute list length ourselves. (dolist (item list) (declare (ignore item)) (incf len)) (when (< len *min-list-length-for-hashtable*) (return-from list-to-hashtable nil)) (let ((hashtable (make-hash-table :test hash-test :size len))) (dolist (item list) (setf (gethash (apply-key key item) hashtable) item)) hashtable))))) ;;; UNION -- Public. ;;; Loading Loading @@ -812,20 +845,32 @@ (setq list1 (Cdr list1)))) res)) (defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) (defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) "Returns the elements of list1 which are not in list2." (declare (inline member)) (if (and testp notp) (error "Test and test-not both supplied.")) (if (null list2) list1 (let ((res nil)) (dolist (elt list1) (if (not (with-set-keys (member (apply-key key elt) list2))) (push elt res))) res))) ;; Quick exit (when (null list2) (return-from set-difference list1)) (let ((hashtable (list-to-hashtable list2 key test test-not))) (cond (hashtable ;; list2 was placed in hash table. (let ((res nil)) (dolist (item list1) (unless (nth-value 1 (gethash (apply-key key item) hashtable)) (push item res))) res)) ((null hashtable) ;; Default implementation because we didn't create the hash ;; table. (let ((res nil)) (dolist (item list1) (if (not (with-set-keys (member (apply-key key item) list2))) (push item res))) res))))) (defun nset-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) Loading tests/sets.lisp 0 → 100644 +91 −0 Original line number Diff line number Diff line ;; Tests for sets (defpackage :sets-tests (:use :cl :lisp-unit)) (in-package "SETS-TESTS") (define-test set-diff.hash-eql (:tag :issues) ;; For set-difference to use hashtables by making the threshold ;; small. (let ((lisp::*min-list-length-for-hashtable* 2)) (assert-equal '(2 2 1) (set-difference '(1 2 2 3) '(3 4))) (assert-equal '(2 2 1) (set-difference '(1 2 2 3) '(3 4 5 6 7 8))) (assert-equal '(2 2 1) (set-difference '(1 2 2 3) '(3 4) :test #'eql)) (assert-equal '(2 2 1) (set-difference '(1 2 2 3) '(3 4 5 6 7 8) :test #'eql)))) (define-test set-diff.hash-eq (:tag :issues) (let ((lisp::*min-list-length-for-hashtable* 2)) (assert-equal '(b b a) (set-difference '(a b b c) '(c d e) :test 'eq)) (assert-equal '(b b a) (set-difference '(a b b c) '(c d e f g h) :test 'eq)) (assert-equal '(b b a) (set-difference '(a b b c) '(c d e) :test #'eq)) (assert-equal '(b b a) (set-difference '(a b b c) '(c d e f g h) :test #'eq)))) (define-test set-diff.hash-equal (:tag :issues) (let ((lisp::*min-list-length-for-hashtable* 2)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("c" "d" "e") :test 'equal)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("c" "d" "e" "f" "g" "h") :test 'equal)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("c" "d" "e") :test #'equal)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("c" "d" "e" "f" "g" "h") :test #'equal)))) (define-test set-diff.hash-equalp (:tag :issues) (let ((lisp::*min-list-length-for-hashtable* 2)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("C" "d" "e") :test 'equalp)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "C") '("c" "D" "e" "f" "g" "h") :test 'equalp)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("C" "d" "e") :test #'equalp)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "C") '("c" "D" "e" "f" "g" "h") :test #'equalp)))) ;; Simple test that we handle a key correctly (define-test set-diff.hash-eql-with-key (let ((lisp::*min-list-length-for-hashtable* 2)) (assert-equal '((3 "b") (2 "b")) (set-difference '((1 "a") (2 "b") (3 "b")) '((1 "a") (4 "c") (5 "d")) :key #'first)))) (define-test set-diff.test-and-test-not (assert-error 'simple-error (set-difference '(1 2) '(3 4) :test 'eql :test-not 'eql))) Loading
src/code/list.lisp +56 −11 Original line number Diff line number Diff line Loading @@ -45,7 +45,7 @@ tree-equal list-length nth %setnth nthcdr last make-list append copy-list copy-alist copy-tree revappend nconc nreconc butlast nbutlast ldiff member member-if member-if-not tailp adjoin union nunion intersection nintersection set-difference nset-difference nunion intersection nintersection nset-difference set-exclusive-or nset-exclusive-or subsetp acons pairlis assoc assoc-if assoc-if-not rassoc rassoc-if rassoc-if-not subst subst-if subst-if-not nsubst nsubst-if nsubst-if-not sublis nsublis)) Loading Loading @@ -744,6 +744,39 @@ list (cons item list))) ;; The minimum length of a list before we can use a hashtable. This ;; was determined experimentally. (defparameter *min-list-length-for-hashtable* 15) ;; Convert a list to a hashtable. The hashtable does not handle ;; duplicated values in the list. Returns the hashtable. (defun list-to-hashtable (list key test test-not) ;; Don't currently support test-not when converting a list to a hashtable (unless test-not (let ((hash-test (let ((test-fn (if (and (symbolp test) (fboundp test)) (fdefinition test) test))) (cond ((eql test-fn #'eq) 'eq) ((eql test-fn #'eql) 'eql) ((eql test-fn #'equal) 'equal) ((eql test-fn #'equalp) 'equalp))))) (unless hash-test (return-from list-to-hashtable nil)) ;; If the list is too short, the hashtable makes things ;; slower. We also need to balance memory usage. (let ((len 0)) ;; Compute list length ourselves. (dolist (item list) (declare (ignore item)) (incf len)) (when (< len *min-list-length-for-hashtable*) (return-from list-to-hashtable nil)) (let ((hashtable (make-hash-table :test hash-test :size len))) (dolist (item list) (setf (gethash (apply-key key item) hashtable) item)) hashtable))))) ;;; UNION -- Public. ;;; Loading Loading @@ -812,20 +845,32 @@ (setq list1 (Cdr list1)))) res)) (defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) (defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) "Returns the elements of list1 which are not in list2." (declare (inline member)) (if (and testp notp) (error "Test and test-not both supplied.")) (if (null list2) list1 (let ((res nil)) (dolist (elt list1) (if (not (with-set-keys (member (apply-key key elt) list2))) (push elt res))) res))) ;; Quick exit (when (null list2) (return-from set-difference list1)) (let ((hashtable (list-to-hashtable list2 key test test-not))) (cond (hashtable ;; list2 was placed in hash table. (let ((res nil)) (dolist (item list1) (unless (nth-value 1 (gethash (apply-key key item) hashtable)) (push item res))) res)) ((null hashtable) ;; Default implementation because we didn't create the hash ;; table. (let ((res nil)) (dolist (item list1) (if (not (with-set-keys (member (apply-key key item) list2))) (push item res))) res))))) (defun nset-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) Loading
tests/sets.lisp 0 → 100644 +91 −0 Original line number Diff line number Diff line ;; Tests for sets (defpackage :sets-tests (:use :cl :lisp-unit)) (in-package "SETS-TESTS") (define-test set-diff.hash-eql (:tag :issues) ;; For set-difference to use hashtables by making the threshold ;; small. (let ((lisp::*min-list-length-for-hashtable* 2)) (assert-equal '(2 2 1) (set-difference '(1 2 2 3) '(3 4))) (assert-equal '(2 2 1) (set-difference '(1 2 2 3) '(3 4 5 6 7 8))) (assert-equal '(2 2 1) (set-difference '(1 2 2 3) '(3 4) :test #'eql)) (assert-equal '(2 2 1) (set-difference '(1 2 2 3) '(3 4 5 6 7 8) :test #'eql)))) (define-test set-diff.hash-eq (:tag :issues) (let ((lisp::*min-list-length-for-hashtable* 2)) (assert-equal '(b b a) (set-difference '(a b b c) '(c d e) :test 'eq)) (assert-equal '(b b a) (set-difference '(a b b c) '(c d e f g h) :test 'eq)) (assert-equal '(b b a) (set-difference '(a b b c) '(c d e) :test #'eq)) (assert-equal '(b b a) (set-difference '(a b b c) '(c d e f g h) :test #'eq)))) (define-test set-diff.hash-equal (:tag :issues) (let ((lisp::*min-list-length-for-hashtable* 2)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("c" "d" "e") :test 'equal)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("c" "d" "e" "f" "g" "h") :test 'equal)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("c" "d" "e") :test #'equal)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("c" "d" "e" "f" "g" "h") :test #'equal)))) (define-test set-diff.hash-equalp (:tag :issues) (let ((lisp::*min-list-length-for-hashtable* 2)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("C" "d" "e") :test 'equalp)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "C") '("c" "D" "e" "f" "g" "h") :test 'equalp)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "c") '("C" "d" "e") :test #'equalp)) (assert-equal '("b" "b" "a") (set-difference '("a" "b" "b" "C") '("c" "D" "e" "f" "g" "h") :test #'equalp)))) ;; Simple test that we handle a key correctly (define-test set-diff.hash-eql-with-key (let ((lisp::*min-list-length-for-hashtable* 2)) (assert-equal '((3 "b") (2 "b")) (set-difference '((1 "a") (2 "b") (3 "b")) '((1 "a") (4 "c") (5 "d")) :key #'first)))) (define-test set-diff.test-and-test-not (assert-error 'simple-error (set-difference '(1 2) '(3 4) :test 'eql :test-not 'eql)))