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

Commits:

1 changed file:

Changes:

  • src/code/list.lisp
    ... ... @@ -748,6 +748,18 @@
    748 748
     (defparameter *min-list-length-for-hashtable*
    
    749 749
       15)
    
    750 750
     
    
    751
    +(defun init-hashtable-list1 (list1 len &key key test)
    
    752
    +  (let ((hashtable (make-hash-table :test test :size len)))
    
    753
    +    (dolist (item list1)
    
    754
    +      (push item (gethash (apply-key key item) hashtable)))
    
    755
    +    (values hashtable list1)))
    
    756
    +
    
    757
    +(defun init-hashtable-list2 (list2 len &key key test)
    
    758
    +  (let ((hashtable (make-hash-table :test test :size len)))
    
    759
    +    (dolist (item list2)
    
    760
    +      (setf (gethash (apply-key key item) hashtable) item))
    
    761
    +    (values hashtable list2)))
    
    762
    +
    
    751 763
     ;; Convert a list to a hashtable.  Given 2 lists, find the shorter of
    
    752 764
     ;; the two lists and add the shorter list to a hashtable.  Returns the
    
    753 765
     ;; hashtable and the shorter list.
    
    ... ... @@ -771,24 +783,28 @@
    771 783
               (do ((length 0 (1+ length))
    
    772 784
                    (l1 list1 (cdr l1))
    
    773 785
                    (l2 list2 (cdr l2)))
    
    774
    -              ((cond ((null l2)
    
    786
    +              ((cond ((endp l2)
    
    775 787
                           (return (values length list2)))
    
    776
    -		     ((null l1)
    
    788
    +		     ((endp l1)
    
    777 789
                           (return (values length list1))))))
    
    778 790
     	;; If the list is too short, the hashtable makes things
    
    779 791
     	;; slower.  We also need to balance memory usage.
    
    780 792
             (when (< len *min-list-length-for-hashtable*)
    
    781 793
               (return-from list-to-hashtable (values nil nil)))
    
    782 794
             (cond ((eq shorter-list list2)
    
    795
    +	       #+nil
    
    783 796
     	       (let ((hashtable (make-hash-table :test test :size len)))
    
    784 797
                      (dolist (item list2)
    
    785 798
                        (setf (gethash (apply-key key item) hashtable) item))
    
    786
    -                 (values hashtable list2)))
    
    799
    +                 (values hashtable list2))
    
    800
    +	       (init-hashtable-list2 list2 len :key key :test test))
    
    787 801
                   ((eq shorter-list list1)
    
    802
    +	       #+nil
    
    788 803
     	       (let ((hashtable (make-hash-table :test test :size len)))
    
    789 804
     		 (dolist (item list1)
    
    790 805
          		   (push item (gethash (apply-key key item) hashtable)))
    
    791
    -		 (values hashtable list1))))))))
    
    806
    +		 (values hashtable list1))
    
    807
    +	       (init-hashtable-list1 list1 len :key key :test test)))))))
    
    792 808
     
    
    793 809
     ;;; UNION -- Public.
    
    794 810
     ;;;
    
    ... ... @@ -857,6 +873,24 @@
    857 873
     	  (setq list1 (Cdr list1))))
    
    858 874
         res))
    
    859 875
     
    
    876
    +(defun set-diff-hash2 (list1 hashtable &key key)
    
    877
    +  (let (diff)
    
    878
    +    (dolist (item list1)
    
    879
    +      (unless (nth-value 1 (gethash (apply-key key item) hashtable))
    
    880
    +        (push item diff)))
    
    881
    +    diff))
    
    882
    +
    
    883
    +(defun set-diff-hash1 (list2 hashtable &key key)
    
    884
    +  (dolist (item list2)
    
    885
    +    (unless (eq hashtable (gethash (apply-key key item) hashtable hashtable))
    
    886
    +      (remhash item hashtable)))
    
    887
    +  (let ((result '()))
    
    888
    +    (maphash #'(lambda (key value)
    
    889
    +		 (declare (ignore key))
    
    890
    +		 (setq result (nconc result value)))
    
    891
    +	     hashtable)
    
    892
    +    result))  
    
    893
    +
    
    860 894
     (defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp))
    
    861 895
       "Returns the elements of list1 which are not in list2."
    
    862 896
       (declare (inline member))
    
    ... ... @@ -878,22 +912,27 @@
    878 912
     	     res))
    
    879 913
     	  ((eq shorter-list list2)
    
    880 914
     	   ;; list2 was placed in hash table.
    
    915
    +	   #+nil
    
    881 916
     	   (let (diff)
    
    882 917
                  (dolist (item list1)
    
    883 918
     	       (unless (nth-value 1 (gethash (apply-key key item) hashtable))
    
    884 919
                      (push item diff)))
    
    885
    -             diff))
    
    920
    +             diff)
    
    921
    +	   (set-diff-hash2 list1 hashtable :key key))
    
    886 922
               ((eq shorter-list list1)
    
    887 923
     	   ;; list1 was placed in the hash table.
    
    924
    +	   #+nil
    
    888 925
                (dolist (item list2)
    
    889 926
     	     (unless (eq hashtable (gethash (apply-key key item) hashtable hashtable))
    
    890 927
                    (remhash item hashtable)))
    
    928
    +	   #+nil
    
    891 929
     	   (let ((result '()))
    
    892 930
     	     (maphash #'(lambda (key value)
    
    893 931
     			  (declare (ignore key))
    
    894 932
     			  (setq result (nconc result value)))
    
    895 933
     		      hashtable)
    
    896
    -	     result)))))
    
    934
    +	     result)
    
    935
    +	   (set-diff-hash1 list2 hashtable :key key)))))
    
    897 936
     
    
    898 937
     
    
    899 938
     (defun nset-difference (list1 list2 &key key