| ... |
... |
@@ -745,6 +745,41 @@ |
|
745
|
745
|
(cons item list)))
|
|
746
|
746
|
|
|
747
|
747
|
|
|
|
748
|
+;; Convert a list to a hashtable. Given 2 lists, find the shorter of
|
|
|
749
|
+;; the two lists and add the shorter list to a hashtable.
|
|
|
750
|
+(defun list-to-hashtable (list1 list2 &key test test-not key)
|
|
|
751
|
+ ;; Don't currently support test-not when converting a list to a hashtable
|
|
|
752
|
+ (unless test-not
|
|
|
753
|
+ (let ((hash-test (let ((test-fn (if (and (symbolp test)
|
|
|
754
|
+ (fboundp test))
|
|
|
755
|
+ (fdefinition test)
|
|
|
756
|
+ test)))
|
|
|
757
|
+ (cond ((eql test-fn #'eq) 'eq)
|
|
|
758
|
+ ((eql test-fn #'eql) 'eql)
|
|
|
759
|
+ ((eql test-fn #'equal) 'equal)
|
|
|
760
|
+ ((eql test-fn #'equalp) 'equalp)))))
|
|
|
761
|
+ (unless hash-test
|
|
|
762
|
+ (return-from list-to-hashtable (values nil nil)))
|
|
|
763
|
+ (multiple-value-bind (len shorter-list)
|
|
|
764
|
+ (do ((length 0 (1+ length))
|
|
|
765
|
+ (l1 list1 (cdr l1))
|
|
|
766
|
+ (l2 list2 (cdr l2)))
|
|
|
767
|
+ ((cond ((null l1)
|
|
|
768
|
+ (return (values length list1)))
|
|
|
769
|
+ ((null l2)
|
|
|
770
|
+ (return (values length list2))))))
|
|
|
771
|
+ (when (< len 15)
|
|
|
772
|
+ (return-from list-to-hashtable (values nil nil)))
|
|
|
773
|
+ (flet ((build-hash (len list)
|
|
|
774
|
+ (let ((hashtable (make-hash-table :test test :size len)))
|
|
|
775
|
+ (dolist (item list)
|
|
|
776
|
+ (setf (gethash (apply-key key item) hashtable) item))
|
|
|
777
|
+ hashtable)))
|
|
|
778
|
+ (cond ((eq shorter-list list2)
|
|
|
779
|
+ (values (build-hash len list2) list2))
|
|
|
780
|
+ ((eq shorter-list list1)
|
|
|
781
|
+ (values (build-hash len list1) list1))))))))
|
|
|
782
|
+
|
|
748
|
783
|
;;; UNION -- Public.
|
|
749
|
784
|
;;;
|
|
750
|
785
|
;;; This function assumes list2 is the result, adding to it from list1 as
|
| ... |
... |
@@ -812,53 +847,37 @@ |
|
812
|
847
|
(setq list1 (Cdr list1))))
|
|
813
|
848
|
res))
|
|
814
|
849
|
|
|
815
|
|
-(defun set-difference (list1 list2 &key key
|
|
816
|
|
- (test #'eql testp) (test-not nil notp))
|
|
|
850
|
+(defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp))
|
|
817
|
851
|
"Returns the elements of list1 which are not in list2."
|
|
818
|
852
|
(declare (inline member))
|
|
819
|
853
|
(if (and testp notp)
|
|
820
|
854
|
(error "Test and test-not both supplied."))
|
|
821
|
|
- (flet ((default-impl (list1 list2)
|
|
822
|
|
- (if (null list2)
|
|
|
855
|
+ (multiple-value-bind (hashtable shorter-list)
|
|
|
856
|
+ (list-to-hashtable list1 list2 :key key :test test :test-not test-not)
|
|
|
857
|
+ (cond ((null hashtable)
|
|
|
858
|
+ ;; Default implementation because we didn't create the hash
|
|
|
859
|
+ ;; table.
|
|
|
860
|
+ (if (null list2)
|
|
823
|
861
|
list1
|
|
824
|
862
|
(let ((res nil))
|
|
825
|
863
|
(dolist (elt list1)
|
|
826
|
864
|
(if (not (with-set-keys (member (apply-key key elt) list2)))
|
|
827
|
865
|
(push elt res)))
|
|
828
|
|
- res))))
|
|
829
|
|
- (cond ((and testp (null key)
|
|
830
|
|
- (member test (list #'eq #'eql #'equal #'equalp)))
|
|
831
|
|
- (multiple-value-bind (len shorter-list)
|
|
832
|
|
- (do ((length 0 (1+ length))
|
|
833
|
|
- (l1 list1 (cdr l1))
|
|
834
|
|
- (l2 list2 (cdr l2)))
|
|
835
|
|
- ((cond ((null l1)
|
|
836
|
|
- (return (values length list1)))
|
|
837
|
|
- ((null l2)
|
|
838
|
|
- (return (values length list2))))))
|
|
839
|
|
- (when (< len 20)
|
|
840
|
|
- (return-from set-difference (default-impl list1 list2)))
|
|
841
|
|
- (flet ((build-hash (len list)
|
|
842
|
|
- (let ((hashtable (make-hash-table :test test :size len)))
|
|
843
|
|
- (dolist (item list)
|
|
844
|
|
- (setf (gethash item hashtable) t))
|
|
845
|
|
- hashtable)))
|
|
846
|
|
- (cond ((eq shorter-list list2)
|
|
847
|
|
- (let ((hashtable (build-hash len list2))
|
|
848
|
|
- diff)
|
|
849
|
|
- (dolist (item list1)
|
|
850
|
|
- (unless (gethash item hashtable)
|
|
851
|
|
- (push item diff)))
|
|
852
|
|
- diff))
|
|
853
|
|
- ((eq shorter-list list1)
|
|
854
|
|
- (let ((hashtable (build-hash len list1)))
|
|
855
|
|
- (dolist (item list2)
|
|
856
|
|
- (when (gethash item hashtable)
|
|
857
|
|
- (remhash item hashtable)))
|
|
858
|
|
- (loop for item being the hash-keys of hashtable
|
|
859
|
|
- collect item)))))))
|
|
860
|
|
- (t
|
|
861
|
|
- (default-impl list1 list2)))))
|
|
|
866
|
+ res)))
|
|
|
867
|
+ ((eq shorter-list list2)
|
|
|
868
|
+ ;; list2 was placed in hash table.
|
|
|
869
|
+ (let (diff)
|
|
|
870
|
+ (dolist (item list1)
|
|
|
871
|
+ (unless (gethash (apply-key key item) hashtable)
|
|
|
872
|
+ (push item diff)))
|
|
|
873
|
+ diff))
|
|
|
874
|
+ ((eq shorter-list list1)
|
|
|
875
|
+ ;; list1 was placed in the hash table.
|
|
|
876
|
+ (dolist (item list2)
|
|
|
877
|
+ (when (gethash (apply-key key item) hashtable)
|
|
|
878
|
+ (remhash item hashtable)))
|
|
|
879
|
+ (loop for item being the hash-values of hashtable
|
|
|
880
|
+ collect item)))))
|
|
862
|
881
|
|
|
863
|
882
|
|
|
864
|
883
|
(defun nset-difference (list1 list2 &key key
|