[Git][cmucl/cmucl][issue-240-set-diff-with-hash-table] 2 commits: Make hashtable support multiset for list1

[Raymond Toy (@rtoy)]

Raymond Toy pushed to branch issue-240-set-diff-with-hash-table at cmucl / cmucl


Commits:
42fd6d23 by Raymond Toy at 2023-06-15T15:23:03-07:00
Make hashtable support multiset for list1

It's important that for list1 the hashtable support multisets since
list1 can be.  This is needed so duplicates in list1 show up in the
output.

This variant was from @cshapiro.

- - - - -
85c8c1df by Raymond Toy at 2023-06-15T15:26:43-07:00
Reverse the output

Reverse the output for the case when list1 is longer so that the order
of the items matches the order of the input.

- - - - -


1 changed file:

- src/code/list.lisp


Changes:

=====================================
src/code/list.lisp
=====================================
@@ -770,15 +770,16 @@
                       (return (values length list2))))))
         (when (< len 15)
           (return-from list-to-hashtable (values nil nil)))
-        (flet ((build-hash (len list)
-                 (let ((hashtable (make-hash-table :test test :size len)))
-                   (dolist (item list)
-                     (setf (gethash (apply-key key item) hashtable) item))
-                   hashtable)))
-          (cond ((eq shorter-list list2)
-		 (values (build-hash len list2) list2))
-                ((eq shorter-list list1)
-		 (values (build-hash len list1) list1))))))))
+        (cond ((eq shorter-list list2)
+	       (let ((hashtable (make-hash-table :test test :size len)))
+                 (dolist (item list2)
+                   (setf (gethash (apply-key key item) hashtable) item))
+                 (values hashtable list2)))
+              ((eq shorter-list list1)
+	       (let ((hashtable (make-hash-table :test test :size len)))
+		 (dolist (item list1)
+     		   (push item (gethash (apply-key key item) hashtable)))
+		 (values hashtable list1))))))))
 
 ;;; UNION -- Public.
 ;;;
@@ -870,14 +871,17 @@
              (dolist (item list1)
 	       (unless (gethash (apply-key key item) hashtable)
                  (push item diff)))
-             diff))
+             (nreverse diff)))
           ((eq shorter-list list1)
 	   ;; list1 was placed in the hash table.
            (dolist (item list2)
-	     (when (gethash (apply-key key item) hashtable)
+	     (unless (eq hashtable (gethash (apply-key key item) hashtable hashtable))
                (remhash item hashtable)))
-           (loop for item being the hash-values of hashtable
-                 collect item)))))
+	   (let ((result '()))
+	     (maphash #'(lambda (key value)
+			  (declare (ignore key))
+			  (setq result (nconc result value)))
+		      hashtable))))))
 
 
 (defun nset-difference (list1 list2 &key key



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5e47bcfc5129d5d7b47b11060adf21a716930838...85c8c1dfb7aa0c0b2fc4d15a23bb9204fd7025bc

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5e47bcfc5129d5d7b47b11060adf21a716930838...85c8c1dfb7aa0c0b2fc4d15a23bb9204fd7025bc
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230615/9cb873b2/attachment-0001.html>