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

Commits:

2 changed files:

Changes:

  • src/code/list.lisp
    ... ... @@ -788,11 +788,18 @@
    788 788
     (defun union (list1 list2 &key key (test #'eql testp) (test-not nil notp))
    
    789 789
       "Returns the union of list1 and list2."
    
    790 790
       (declare (inline member))
    
    791
    -  (when (and testp notp) (error (intl:gettext "Test and test-not both supplied.")))
    
    792
    -  (let ((res list2))
    
    793
    -    (dolist (elt list1)
    
    794
    -      (unless (with-set-keys (member (apply-key key elt) list2))
    
    795
    -	(push elt res)))
    
    791
    +  (when (and testp notp)
    
    792
    +    (error (intl:gettext "Test and test-not both supplied.")))
    
    793
    +  (let ((res list2)
    
    794
    +	(hashtable (list-to-hashtable list2 key test test-not)))
    
    795
    +    (cond (hashtable
    
    796
    +	   (dolist (item list1)
    
    797
    +	     (unless (nth-value 1 (gethash (apply-key key item) hashtable))
    
    798
    +	       (push item res))))
    
    799
    +	  ((null hashtable)
    
    800
    +	   (dolist (item list1)
    
    801
    +	     (unless (with-set-keys (member (apply-key key item) list2))
    
    802
    +	       (push item res)))))
    
    796 803
         res))
    
    797 804
     
    
    798 805
     ;;; Destination and source are setf-able and many-evaluable.  Sets the source
    
    ... ... @@ -825,11 +832,20 @@
    825 832
       (declare (inline member))
    
    826 833
       (if (and testp notp)
    
    827 834
           (error "Test and test-not both supplied."))
    
    828
    -  (let ((res nil))
    
    829
    -    (dolist (elt list1)
    
    830
    -      (if (with-set-keys (member (apply-key key elt) list2))
    
    831
    -	  (push elt res)))
    
    832
    -    res))
    
    835
    +  (let ((hashtable 
    
    836
    +	  (list-to-hashtable list2 key test test-not)))
    
    837
    +    (cond (hashtable
    
    838
    +	   (let ((res nil))
    
    839
    +	     (dolist (item list1)
    
    840
    +	       (when (nth-value 1 (gethash (apply-key key item) hashtable))
    
    841
    +		 (push item res)))
    
    842
    +	     res))
    
    843
    +	  ((null hashtable)
    
    844
    +	   (let ((res nil))
    
    845
    +	     (dolist (elt list1)
    
    846
    +	       (if (with-set-keys (member (apply-key key elt) list2))
    
    847
    +		   (push elt res)))
    
    848
    +	     res)))))
    
    833 849
     
    
    834 850
     (defun nintersection (list1 list2 &key key
    
    835 851
     			    (test #'eql testp) (test-not nil notp))
    

  • tests/sets.lisp
    ... ... @@ -89,3 +89,86 @@
    89 89
     				:test-not 'eql)))
    
    90 90
     
    
    91 91
        
    
    92
    +
    
    93
    +(define-test union.hash-eql
    
    94
    +    (:tag :issues)
    
    95
    +  ;; For union to use hashtables by making the threshold
    
    96
    +  ;; small.
    
    97
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    
    98
    +    (assert-equal '(2 2 1 3 4)
    
    99
    +		  (union '(1 2 2 3) '(3 4)))
    
    100
    +    (assert-equal '(2 2 1 3 4 5 6 7 8)
    
    101
    +		  (union '(1 2 2 3) '(3 4 5 6 7 8)))
    
    102
    +    (assert-equal '(2 2 1 3 4)
    
    103
    +		  (union '(1 2 2 3) '(3 4)
    
    104
    +			 :test #'eql))
    
    105
    +    (assert-equal '(2 2 1 3 4 5 6 7 8)
    
    106
    +		  (union '(1 2 2 3) '(3 4 5 6 7 8)
    
    107
    +			 :test #'eql))))
    
    108
    +
    
    109
    +(define-test union.hash-eq
    
    110
    +    (:tag :issues)
    
    111
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    
    112
    +    (assert-equal '(b b a c d e)
    
    113
    +		  (union '(a b b c) '(c d e) :test 'eq))
    
    114
    +    (assert-equal '(b b a c d e f g h)
    
    115
    +		  (union '(a b b c) '(c d e f g h) :test 'eq))
    
    116
    +    (assert-equal '(b b a c d e)
    
    117
    +		  (union '(a b b c) '(c d e) :test #'eq))
    
    118
    +    (assert-equal '(b b a c d e f g h)
    
    119
    +		  (union '(a b b c) '(c d e f g h) :test #'eq))))
    
    120
    +
    
    121
    +(define-test union.hash-equal
    
    122
    +    (:tag :issues)
    
    123
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    
    124
    +    (assert-equal '("b" "b" "a" "c" "d" "e")
    
    125
    +		  (union '("a" "b" "b" "c")
    
    126
    +			 '("c" "d" "e")
    
    127
    +			 :test 'equal))
    
    128
    +    (assert-equal '("b" "b" "a" "c" "d" "e" "f" "g" "h")
    
    129
    +		  (union '("a" "b" "b" "c")
    
    130
    +			 '("c" "d" "e" "f" "g" "h")
    
    131
    +			 :test 'equal))
    
    132
    +    (assert-equal '("b" "b" "a" "c" "d" "e")
    
    133
    +		  (union '("a" "b" "b" "c")
    
    134
    +			 '("c" "d" "e")
    
    135
    +			 :test #'equal))
    
    136
    +    (assert-equal '("b" "b" "a" "c" "d" "e" "f" "g" "h")
    
    137
    +		  (union '("a" "b" "b" "c")
    
    138
    +			 '("c" "d" "e" "f" "g" "h")
    
    139
    +			 :test #'equal))))
    
    140
    +
    
    141
    +(define-test union.hash-equalp
    
    142
    +    (:tag :issues)
    
    143
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    
    144
    +    (assert-equal '("b" "b" "a" "C" "d" "e")
    
    145
    +		  (union '("a" "b" "b" "c")
    
    146
    +			 '("C" "d" "e")
    
    147
    +			 :test 'equalp))
    
    148
    +    (assert-equal '("b" "b" "a" "c" "D" "e" "f" "g" "h")
    
    149
    +		  (union '("a" "b" "b" "C")
    
    150
    +			 '("c" "D" "e" "f" "g" "h")
    
    151
    +			 :test 'equalp))
    
    152
    +    (assert-equal '("b" "b" "a" "C" "d" "e")
    
    153
    +		  (union '("a" "b" "b" "c")
    
    154
    +			 '("C" "d" "e")
    
    155
    +			 :test #'equalp))
    
    156
    +    (assert-equal '("b" "b" "a" "c" "D" "e" "f" "g" "h")
    
    157
    +		  (union '("a" "b" "b" "C")
    
    158
    +			 '("c" "D" "e" "f" "g" "h")
    
    159
    +			 :test #'equalp))))
    
    160
    +
    
    161
    +;; Simple test that we handle a key correctly
    
    162
    +(define-test union.hash-eql-with-key
    
    163
    +  (let ((lisp::*min-list-length-for-hashtable* 2))
    
    164
    +    (assert-equal '((3 "b") (2 "b") (1 "a") (4 "c") (5 "d"))
    
    165
    +		  (union '((1 "a") (2 "b") (3 "b"))
    
    166
    +			 '((1 "a") (4 "c") (5 "d"))
    
    167
    +			 :key #'first))))
    
    168
    +
    
    169
    +(define-test union.test-and-test-not
    
    170
    +  (assert-error 'simple-error
    
    171
    +		(union '(1 2)
    
    172
    +		       '(3 4)
    
    173
    +		       :test 'eql
    
    174
    +		       :test-not 'eql)))