Removing All Repetitive Elements from a Sequence

Viewed 240

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)))
3 Answers

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))

Something like this with read-time computed functions will not do what you think. Simplified from your code:

(defun foo (a b test)
  #.(defun equality-test (x y)
      (funcall test x y))
  (funcall #'equality-test a b))

There is no way this can work.

Reason 1: a read time created function does not have access to lexical variables from the surrounding code (here there is no way to reference test, since an environment with a function foo does not exist during reading)

The test variable inside equality-test is not referring to a lexical variable. It's undefined/undeclared.

Reason 2: the DEFUN evaluates to a symbol

The code looks like this after reading and evaluating the read-time code:

(defun foo (a b test)
   equality-test
   (funcall #'equality-test a b))

Well, equality-test is an unbound variable. Which is an error at runtime.

Reason 3: the function equality-test might not exist

If we compile the code with the file compiler, the function equality-test is created inside the compile-time environment during reading the form, but it will not be a part of the compiled code.

Disclaimer: I find @Sylwester's answer clearer and cleaner - just better (without macro).

However, this is just hypothetical (but not a good practice):

(ql:quickload :iterate)    ;; you forgot these - but they are necessary
(use-package :iterate)     ;; for your code to run - at least my definition
(ql:quickload :alexandria) ;; of 'minimal working example' is to include imports.

(defmacro remove-equals (sequence &key (test #'eql) (start 0) end (key #'identity))
  "Remove all repetitive sequence alements based on equality test."
  (alexandria:once-only (sequence test start end key) ; as hygyenic macro
    `(progn
       (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 (funcall ,key elt) ht)))
                     ,sequence :start ,start :end ,end :key ,key)))))

(remove-equals '(1 2 3 1 4 5 3) :test #'= :end 6)
;; WARNING: redefining COMMON-LISP-USER::EQUALITY-TEST in DEFUN
;; 
;; (2 3 4 5 3)

(describe 'equality-test) ;; shows new definition
;; COMMON-LISP-USER::EQUALITY-TEST
;;   [symbol]
;; 
;; EQUALITY-TEST names a compiled function:
;;   Lambda-list: (X Y)
;;   Derived type: (FUNCTION (T T) (VALUES BOOLEAN &OPTIONAL))
;;   Source form:
;;     (SB-INT:NAMED-LAMBDA EQUALITY-TEST
;;         (X Y)
;;       (BLOCK EQUALITY-TEST
;;         (FUNCALL #'= (FUNCALL #1=#<FUNCTION IDENTITY> X)
;;                  (FUNCALL #1# Y))))

The warning will always occur - and if you use more than just one hash tables, this will definitely interfere and cause errors. So I don't recommend that!

Related