Raymond Toy pushed to branch master at cmucl / cmucl Commits: db531fef by Raymond Toy at 2023-08-30T17:59:50+00:00 Address #240: Add hashtable for set-exclusive-or - - - - - 766c6aa5 by Raymond Toy at 2023-08-30T18:00:08+00:00 Merge branch 'issue-240-add-hashtable-set-exclusive-or' into 'master' Address #240: Add hashtable for set-exclusive-or See merge request cmucl/cmucl!169 - - - - - 3 changed files: - src/code/list.lisp - src/i18n/locale/cmucl.pot - tests/sets.lisp Changes: ===================================== src/code/list.lisp ===================================== @@ -928,7 +928,7 @@ (defun set-exclusive-or (list1 list2 &key key (test #'eql testp) (test-not nil notp)) - "Return new list of elements appearing exactly once in LIST1 and LIST2." + "Return new list of elements appearing exactly one of LIST1 and LIST2." (declare (inline member)) (let ((result nil) (key (when key (coerce key 'function))) @@ -936,19 +936,38 @@ (test-not (if test-not (coerce test-not 'function) #'eql))) (declare (type (or function null) key) (type function test test-not)) - (dolist (elt list1) - (unless (with-set-keys (member (apply-key key elt) list2)) - (setq result (cons elt result)))) - (let ((test (if testp - (lambda (x y) (funcall test y x)) - test)) - (test-not (if notp - (lambda (x y) (funcall test-not y x)) - test-not))) - (dolist (elt list2) - (unless (with-set-keys (member (apply-key key elt) list1)) - (setq result (cons elt result))))) - result)) + ;; Find the elements in list1 that do not appear in list2 and add + ;; them to the result. + (macrolet + ((compute-membership (item-list test-form) + `(dolist (elt ,item-list) + (unless ,test-form + (setq result (cons elt result)))))) + (let ((hashtable (list-to-hashtable list2 key test test-not))) + (cond + (hashtable + (compute-membership list1 + (nth-value 1 (gethash (apply-key key elt) hashtable)))) + (t + (compute-membership list1 + (with-set-keys (member (apply-key key elt) list2)))))) + ;; Now find the elements in list2 that do not appear in list1 and + ;; them to the result. + (let ((hashtable (list-to-hashtable list1 key test test-not))) + (cond + (hashtable + (compute-membership list2 + (nth-value 1 (gethash (apply-key key elt) hashtable)))) + (t + (let ((test (if testp + (lambda (x y) (funcall test y x)) + test)) + (test-not (if notp + (lambda (x y) (funcall test-not y x)) + test-not))) + (compute-membership list2 + (with-set-keys (member (apply-key key elt) list1))))))) + result))) ;;; The outer loop examines list1 while the inner loop examines list2. If an ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -3236,7 +3236,7 @@ msgid "Destructively returns the elements of list1 which are not in list2." msgstr "" #: src/code/list.lisp -msgid "Return new list of elements appearing exactly once in LIST1 and LIST2." +msgid "Return new list of elements appearing exactly one of LIST1 and LIST2." msgstr "" #: src/code/list.lisp ===================================== tests/sets.lisp ===================================== @@ -279,3 +279,26 @@ '(3 4) :test 'eql :test-not 'equal))) + +(define-test set-exclusive-or.1 + (:tag :issues) + (flet + ((test (min-length) + ;; From CLHS + (let ((lisp::*min-list-length-for-hashtable* min-length)) + (assert-equal '("b" "A" "b" "a") + (set-exclusive-or '(1 "a" "b") + '(1 "A" "b"))) + (assert-equal '("A" "a") + (set-exclusive-or '(1 "a" "b") + '(1 "A" "b") + :test #'equal)) + (assert-equal nil + (set-exclusive-or '(1 "a" "b") + '(1 "A" "b") + :test #'equalp))))) + ;; Test the list impl by making the min length large. Then test + ;; the hashtable impl with a very short min length + (test 100) + (test 2))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/77dee6275790bafea5b0081... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/77dee6275790bafea5b0081... You're receiving this email because of your account on gitlab.common-lisp.net.