The Common Lisp sequence function remove-duplicates
leaves behind one element of each multiplicity. The goal of the following analogous function remove-equals
is to remove all multiplicities.
However, I want to use the built-in function remove-if
(not iteration), and the hash table facilities of SBCL for the :test function to keep the time complexity at O(n). The immediate problem is that the SBCL equality test needs to be global, but the test also needs to depend on the key
argument to remove-equals
. Can it be written to satisfy both requirements?
(defun remove-equals (sequence &key (test #'eql) (start 0) end (key #'identity))
"Removes all repetitive sequence elements based on equality test."
#.(defun equality-test (x y)
(funcall test (funcall key x) (funcall key y)))
#.(sb-ext:define-hash-table-test equality-test sxhash)
(let ((ht (make-hash-table :test #'equality-test)))
(iterate (for elt in-sequence (subseq sequence start end))
(incf (gethash (funcall key elt) ht 0)))
(remove-if (lambda (elt)
(/= 1 (gethash elt ht)))
sequence :start start :end end :key key)))
The third argument to define-hash-table-test
associates a test with a hash function. Using sxhash
defeats the purpose since it should be tailored to the test
function. (equal x y)
implies (= (sxhash x) (sxhash))
. Thus the second parameter should be a function test-hash
such that (funcall test x y)
implies (= (test-hash x) (test-hash y))
. It's impossible to do this from just having the test function. It would perhaps be better just to circumvent the whole thing by documenting that it needs to have hash support:
(defun remove-duplicated (sequence &key (test #'eql) (start 0) end (key #'identity))
"Removes all repetitive sequence elements based on equality test.
equalily tests other than eq, eql, equal and equalp requires you
add it to be allowed in a hash table eg. sb-ext:define-hash-table-test in SBCL"
(let ((ht (make-hash-table :test test)))
(iterate (for elt in-sequence (subseq sequence start end))
(incf (gethash (funcall key elt) ht 0)))
(remove-if (lambda (elt)
(/= 1 (gethash elt ht)))
sequence :start start :end end :key key)))
Now if a user should want a custom test they need to to it themselves:
(defun car-equals (a b)
(equal (car a) (car b)))
(defun car-equals-hash (p)
(sxhash (car p)))
(sb-ext:define-hash-table-test car-equals car-equals-hash)
(car-equals '(1 2 3 4) '(1 3 5 7)) ; ==> t
(defparameter *ht* (make-hash-table :test 'car-equals))
(setf (gethash '(1 2 3 4) *ht*) 'found)
(gethash '(1 3 5 7) *ht*) ; ==> found
(remove-duplicated '((5 0 1 2) (5 1 2 3) (5 1 3 2) (5 2 3 4))
:test #'car-equals
:key #'cdr)
; ==> ((5 0 1 2) (5 2 3 4))