2
\$\begingroup\$

This is an experiment on extending a basic built-in Common Lisp sequence function (namely remove), in order to provide more functionality with little or no impact on performance. The long-term goal might be to provide such extensions for many other CL functions.

The CL sequence functions seem to provide at least 3 different kinds of abstraction: 1) data type abstraction, where a sequence can be a list, vector, or string; 2) higher-order functions, where a function can be passed as a parameter; and 3) keyword parameters, where different keyword arguments can tailor the computation for specific uses.

The basic idea explored here is to add many more keywords, to give the programmer more capability & flexibility in processing sequences. If successful, this could obviate the need to write (or recall) many sequence-supporting utility functions. It could also consolidate some of the existing CL sequence functions (eg, remove, remove-if, remove-if-not, delete, delete-if, delete-if-not, remove-duplicates, delete-duplicates) into one operation (in this case simply called "remove-sequence" with extra keywords for :destructive and :duplicates). Other non-sequence "remove related" consolidations also might be possible--eg, for remhash, remprop, etc.

As an example, consider that there is no built-in provision for removing elements from a sequence based on their index. Along these lines, it might be convenient to have an :index-test keyword that took a function like (lambda (idx elt) (= idx elt)), such that (remove-sequence (list 2 1 0) :index-test (lambda (idx elt) (= idx elt))) -> (2 0). An included index-aware capability would save writing/finding the appropriate utility.

The following extensions add many more such keywords to remove-sequence to see how many are required to generalize on the basic remove functionality. Note that remove-sequence then has only one required argument, the input sequence, with everything else specified by selecting keywords.

The following keywords are added so far (in addition to the standard built-in sequence keywords :from-end, :test, :test-not, :start, :end, :count, :key):

:item -- Simply moves the required item parameter in remove to a keyword for consistency. (remove item sequence ...) = (remove-sequence sequence :item item ...). Example: (remove-sequence (list 1 2 3) :item 1) -> (2 3).

:items -- Extends the built-in capability for removing a single item from a sequence to multiple items. More intuitive than using (remove-if (lambda (elt) (position elt items)) sequence ...). Example: (remove-sequence (list 1 2 3) :items '(1 2)) -> (3).

:index-test -- A designator for a function of 2 arguments: a sequence index and the corresponding element. Allows processing sequences based on element indices. Example: (remove-sequence (list 2 1 0) :index-test (lambda (idx elt) (= idx elt))) -> (2 0)

:duplicates -- A boolean indicating whether to remove duplicates or not. Folds in the functionality of remove-duplicates. Example: (remove-sequence (list 1 2 3 2 1) :duplicates t) -> (1 2 3).

:duplicated -- A boolean indicating whether to remove all instances of duplicated items. Example: (remove-sequence (list 1 2 3 2 1) :duplicated t) -> (3).

:destructive -- A boolean indicating whether the input sequence may be modified or not. Consolidates remove & delete function variations. Example: (defparameter *sequence* (list 1 2 3)), (remove-sequence *sequence* :item 2 :destructive t) -> (1 3), where the input sequence may be altered to produce the result for efficiency reasons.

The basic operation remove-sequence is implemented as a set of nested macros, which translate a macro call with particular keyword parameters into a built-in CL sequence function. This avoids macro run-time argument evaluation difficulties, avoids extra effort in duplicating built-in CL functionality, takes advantage of the highly tuned & debugged CL sequence functions, and permits compile-time checking for appropriate combinations of keywords. The function labeled present-absent with arguments for positive and negative keywords for each translation, determines whether a particular selection of keyword arguments in a macro call is valid or invalid. (With a total of 13 keywords so far, there are many possible combinations, some of which are inconsistent.)

Here are a few issues that I would like to understand better:

1) This approach builds on the established CL paradigm of specializing a basic function with keywords. But is there a downside to adding too many keywords?

2) I can't think of any more "remove related" keywords for generalizing remove-sequence, but I assume there could be more. Could there be many more?

3) Different keywords are appropriate for different basic functions (eg, remove from a sequence and remove from a tree). How does having a bunch of keywords at your disposal compare with a bunch of utilities? (I think I would prefer keywords because they seem more integrated with the language and reduce the search for relevant libraries, but my CL project experience is limited.)

4) Is there a better way to implement the same kind of functionality? Thank you for a review...

(ql:quickload :iterate)

(ql:quickload :alexandria)

(defpackage :rem (:use :cl :iterate :alexandria))

(in-package :rem)


(defmacro verify (expression value)
  "Simple test to verify that the macro expression evaluates to the given value."
  `(progn (unless (equalp ,expression ,value)
            (error "Verify failed for ~A = ~A" ',expression ,value))
          ,expression))


(defmacro rem/del-item (sequence &key item items from-end (test #'eql) (start 0) end
                                 count (key #'identity) destructive)
  "Removes/deletes item (or sequence of items) from sequence."
  (if items
    (if destructive
      `(delete-if (lambda (elt) (position elt ,items :test ,test)) ,sequence
                  :from-end ,from-end :start ,start :end ,end :count ,count :key ,key)
      `(remove-if (lambda (elt) (position elt ,items :test ,test)) ,sequence
                  :from-end ,from-end :start ,start :end ,end :count ,count :key ,key))
    (if destructive
      `(delete ,item ,sequence :from-end ,from-end :test ,test :start ,start
               :end ,end :count ,count :key ,key)
      `(remove ,item ,sequence :from-end ,from-end :test ,test :start ,start
               :end ,end :count ,count :key ,key))))


(verify (rem/del-item '(1 2 3) :item 2)
        `(1 3))


(verify (rem/del-item '(1 2 nil 3) :item nil)
        `(1 2 3))


(verify (rem/del-item '((5 0 1 2) (5 1 2 3) (5 1 3 2) (4 1 2 3))
                      :item 2 :from-end t :test #'= :count 1 :key #'fourth)
        `((5 0 1 2) (5 1 2 3) (4 1 2 3)))


(verify (rem/del-item '(1 2 3 4 5) :items '(3 4) :test #'=)
        `(1 2 5))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defmacro rem/del-duplicated (sequence &key (test #'eql) (start 0) end
                                       (key #'identity) destructive)
  "Removes/deletes all repeated sequence elements based on an equality test."
  `(let ((ht (make-hash-table :test ,test :size (length ,sequence))))
     (iterate (for elt in-sequence (subseq ,sequence ,start ,end))
              (incf (gethash (funcall ,key elt) ht 0)))
     ,(if destructive
        `(delete-if (lambda (elt)
                      (/= 1 (gethash elt ht)))
                    ,sequence :start ,start :end ,end :key ,key)
        `(remove-if (lambda (elt)
                      (/= 1 (gethash elt ht)))
                    ,sequence :start ,start :end ,end :key ,key))))


(verify (rem/del-duplicated '((5 0 1 2) (5 1 2 3) (5 1 3 2) (4 1 2 3))
                           :test #'equal :key #'cdr)
        `((5 0 1 2) (5 1 3 2)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defmacro rem/del-duplicates (sequence &key from-end (test #'eql) (start 0) end
                                       (key #'identity) destructive)
  "Removes/deletes duplicates from sequence."
  (if destructive
      `(delete-duplicates ,sequence :from-end ,from-end :test ,test :start ,start
                          :end ,end :key ,key)
    `(remove-duplicates ,sequence :from-end ,from-end :test ,test :start ,start
                        :end ,end :key ,key)))


(verify (rem/del-duplicates '((5 0 1 2) (5 1 2 3) (5 1 3 2) (4 1 2 3))
                            :test #'equal :key #'cdr)
        `((5 0 1 2) (5 1 3 2) (4 1 2 3)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defmacro rem/del-indexed (sequence &key from-end index-test (start 0) end
                                    count (key #'identity) destructive)
  "Removes/deletes elements satisfying the index-test (index element) in sequence."
  `(let* ((delta (if ,from-end -1 +1))
          (initial-index (if ,from-end (length ,sequence) -1))
          (closure (let ((index initial-index))
                     (lambda (element)
                       (incf index delta)
                       (funcall ,index-test index (funcall ,key element))))))
     ,(if destructive
          `(delete-if closure ,sequence :from-end ,from-end :start ,start :end ,end
                      :count ,count :key ,key)
        `(remove-if closure ,sequence :from-end ,from-end :start ,start :end ,end
                    :count ,count :key ,key))))


(verify (rem/del-indexed '(3 1 2 4) :index-test (lambda (idx elt) (= idx elt)))
        '(3 4))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defun present-absent (positives negatives)
  "Determines whether a selection of keyword arguments is valid or invalid."
  (and (every (complement #'null) positives)
       (every #'null negatives)))

(defmacro remove-sequence (sequence &key item items (test #'eql) index-test from-end (start 0) end
                                     count (key #'identity) duplicates duplicated destructive)
  "Sequence operations for removing or deleting elements."
  (cond ((present-absent `(,sequence) `(,index-test ,duplicates ,duplicated))
          `(rem/del-item ,sequence :item ,item :items ,items :from-end ,from-end :test ,test
                         :start ,start :end ,end :count ,count :key ,key :destructive ,destructive))
        ((present-absent `(,sequence ,duplicated) `(,item ,index-test ,duplicates))
          `(rem/del-duplicated ,sequence :test ,test :start ,start :end ,end
                               :key ,key :destructive ,destructive))
        ((present-absent `(,sequence ,duplicates) `(,item ,index-test ,duplicated))
          `(rem/del-duplicates ,sequence :from-end ,from-end :test ,test :start ,start :end ,end
                               :key ,key :destructive ,destructive))
        ((present-absent `(,sequence ,index-test) `(,item ,test ,duplicates ,duplicated))
          `(rem/del-indexed ,sequence :from-end ,from-end :index-test ,index-test :start ,start
                            :end ,end :key ,key :destructive ,destructive))
        (t (error "Malformed argument list to remove-sequence."))))


(verify (remove-sequence '((5 0 1 2) (5 1 2 3) (5 1 3 2) (4 1 2 3))
                         :item 2 :from-end t :test #'= :count 1 :key #'fourth)
        '((5 0 1 2) (5 1 2 3) (4 1 2 3)))


(verify (remove-sequence '(1 2 nil 3) :item nil)
        `(1 2 3))


(verify (remove-sequence '(1 2 3 4 5) :items '(3 4) :test #'=)
        `(1 2 5))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defmacro rem/del-ht-entry (hashtable &key item items (test #'eql) (key #'identity) destructive)
   "Removes/deletes an item (or sequence of items) from a hashtable."
   (if items
      (if destructive
         (if (eq `,key #'identity)
            `(iterate (for elt in-sequence ,items)
                      (remhash elt ,hashtable)
                      (finally (return ,hashtable)))
            `(progn (maphash (lambda (k v)
                                (declare (ignore v))
                                (when (position (funcall ,key k) ,items)
                                   (remhash k ,hashtable)))
                             ,hashtable)
                    ,hashtable))
         (if (eq `,key #'identity)
            `(let ((new-ht (alexandria:copy-hash-table ,hashtable)))
                (iterate (for elt in-sequence ,items)
                         (remhash elt new-ht)
                         (finally (return new-ht))))
            `(let ((new-ht (alexandria:copy-hash-table ,hashtable)))
                (maphash (lambda (k v)
                            (declare (ignore v))
                            (when (position (funcall ,key k) ,items)
                               (remhash k new-ht)))
                         new-ht)
                new-ht)))
     (if destructive
        (if (eq `,key #'identity)
           `(remhash ,item ,hashtable)
           `(progn (maphash (lambda (k v)
                               (declare (ignore v))
                               (when (funcall ,test ,item (funcall ,key k))
                                  (remhash k ,hashtable)))
                            ,hashtable)
                   ,hashtable))  
       (if (eq `,key #'identity)
          `(let ((new-ht (alexandria:copy-hash-table ,hashtable)))
              (remhash ,item ht)
              new-ht)
          `(let ((new-ht (alexandria:copy-hash-table ,hashtable)))
              (maphash (lambda (k v)
                          (declare (ignore v))
                          (when (funcall ,test ,item (funcall ,key k))
                             (remhash k ht)))
                       new-ht)
              new-ht)))))


(defmacro rem/del-hashtable (hashtable &key item items (test #'eql) (key #'identity) destructive)
  (cond ((present-absent `(,hashtable) '(nil))
           `(rem/del-ht-entry ,hashtable :item ,item :items ,items :test ,test :key ,key
                              :destructive ,destructive))
         (t (error "Malformed argument list to rem/del-hashtable."))))


(defparameter *ht* (let ((ht (make-hash-table :test #'equal)))
                     (setf (gethash '(1 1) ht) 'a
                           (gethash '(2 2) ht) 'b
                           (gethash '(3 3) ht) 'c)
                     ht))


(verify (rem/del-hashtable *ht* :item 1 :test #'= :key #'car :destructive t)
        (let ((ht (make-hash-table :test #'equal)))
          (setf (gethash '(2 2) ht) 'b
                (gethash '(3 3) ht) 'c)
          ht))


(verify (rem/del-hashtable *ht* :items #(2 3) :test #'= :key #'car)
        (make-hash-table :test #'equal))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defmacro remove+ (container &key item items (test #'eql) index-test from-end (start 0) end count
                             (key #'identity) duplicates duplicated destructive)
  "Generalization of remove for some types of containers."
  (cond ((typep container 'sequence)
          `(remove-sequence ,container :item ,item :items ,items :test ,test :index-test ,index-test
             :from-end ,from-end :start ,start :end ,end :count ,count :key ,key
             :duplicates ,duplicates :duplicated ,duplicated :destructive ,destructive))
        ((typep container 'hash-table)
          `(rem/del-hashtable ,container :item ,item :items ,items :test ,test :key ,key :destructive ,destructive))
        ((error "First argument must be a sequence or hash-table container object: ~A~%" container))))


(verify (remove+ '(1 2 3 4 5) :items '(3 4) :test #'=)
        `(1 2 5))
\$\endgroup\$
  • \$\begingroup\$ how should (if destructive work? \$\endgroup\$ – Rainer Joswig Jul 27 at 17:28
  • \$\begingroup\$ Please do not update the code in your question to incorporate feedback from answers, doing so goes against the Question + Answer style of Code Review. This is not a forum where you should keep the most updated version in your question. Please see what you may and may not do after receiving answers. \$\endgroup\$ – Simon Forsberg Jul 28 at 18:55
1
\$\begingroup\$

This won't work as intendent since a macro sees source, not values:

(if destructive
   `(delete-if (lambda (elt) (position elt ,items :test ,test)) ,sequence
               :from-end ,from-end :start ,start :end ,end :count ,count :key ,key)
   `(remove-if (lambda (elt) (position elt ,items :test ,test)) ,sequence
               :from-end ,from-end :start ,start :end ,end :count ,count :key ,key))

Even if it were working, it is lots of duplication.

`(,(if destructive 'delete-if 'remove-if)
  (lambda (elt) (position elt ,items :test ,test)) ,sequence
  :from-end ,from-end :start ,start :end ,end :count ,count :key ,key)

Which still does not work, because destructive isn't a runtime value.

\$\endgroup\$
  • \$\begingroup\$ Good catch. Would it be considered bad form to require simple boolean rather than generalized boolean? \$\endgroup\$ – davypough Jul 28 at 0:52
  • \$\begingroup\$ I've edited the original macro to disallow nonatomic values. \$\endgroup\$ – davypough Jul 28 at 18:32

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.