替换子序列的标准函数

Question

我经常需要用另一个相同类型的序列替换某些元素的子序列，但可能是长度不同的序列。实现这类功能并不是一项挑战，我现在使用的是：

(defun substitute* (new old where &key key (test #'eql))
  (funcall (alambda (rest)
             (aif (search old rest :key key :test test)
                  (concatenate (etypecase rest
                                 (string 'string)
                                 (vector 'vector)
                                 (list 'list))
                               (subseq rest 0 it)
                               new
                               (self (subseq rest (+ it (length old)))))
                  rest))
           where))

工作方式如下：

CL-USER> (substitute* '(x y) '(z) '(1 z 5 8 y z))
(1 X Y 5 8 Y X Y)
CL-USER> (substitute* "green button" "red button"
                      "here are red indicator, red button and red wire")
"here are red indicator, green button and red wire"
CL-USER> (substitute* #(4) #(2 2) #(2 2 2 2 2))
#(4 4 2)

您知道，它非常方便和有用，所以我觉得我正在重新发明轮子，它必须在标准库中，我只是不知道它的名称(有时名称并不明显，您可以搜索filter，而您需要的是set-difference)。

由于透明度和效率之间的妥协：

(defun substitute* (new old where &key key (test #'eql))
  (let ((type (etypecase where
                (string 'string)
                (vector 'vector)
                (list 'list)))
        (new (coerce new 'list))
        (old (coerce old 'list))
        (where (coerce where 'list)))
    (coerce (funcall (alambda (rest)
                       (aif (search old rest :key key :test test)
                            (append (remove-if (constantly t) rest :start it)
                                    new
                                    (self (nthcdr (+ it (length old)) rest)))
                            rest))
                     where)
            type)))

Answer 1

我不认为这有什么标准的功能。它比标准的replace函数族更复杂。这些操作可以破坏性地进行，因为您事先知道可以逐个元素替换。即使在这种情况下，有效地完成任务仍然有些困难，因为列表和向量的访问时间非常不同，所以像subseq这样的通用函数可能会有问题。As Rainer Joswig pointed out in a comment

不幸的是，对于序列上的许多算法来说，没有单一的高效实现。我经常看到有两个版本，一个用于列表，另一个用于向量，然后隐藏在调度函数后面。对于黑客来说，简单的通用版本是可以的，但是对于库函数，通常有不同的实现--如下图所示。

(事实上，在对某个库是否包含函数进行了一些研究时，我得到的第一个谷歌结果之一是关于代码审查( Code，Generic sequence splitter in Common Lisp )的一个问题，在这个问题中，雷纳和我都有一些类似于这里的评论。)

列表的版本

但是，您的实现效率很低，因为它生成多个序列剩余部分的副本。例如，当您用(z)替换(1 z 2 z 3 z)中的(x y)时，您将首先生成(3 x y)，然后在生成(2 x y 3 z y)中复制它，然后在生成(1 x y 2 x y 3 x y)中复制它。您最好先对序列进行一次遍历，确定要替换的子序列的索引，或者收集不需要替换的位，等等。您可能需要对列表和其他序列分别实现。例如，有了一份清单，你可以：

(defun splice-replace-list (old new list)
  (do ((new (coerce new 'list)) 
       (old-len (length old))
       (parts '()))
      ((endp list)
       (reduce 'append (nreverse parts) :from-end t))
    (let ((pos (search old list)))
      (push (subseq list 0 pos) parts)
      (cond 
        ((null pos)
         (setf list nil))
        (t 
         (push new parts)
         (setf list (nthcdr (+ old-len pos) list)))))))

如果您愿意的话，您可以在这里进行一些优化。例如，您可以实现一个search-list，它不是返回所查找序列的第一个实例的位置，而是返回一个头部的副本，直到那个点，并以序列开头的序列作为多个值开始，甚至是复制的头部，以及序列后面的尾部，因为这正是您真正感兴趣的地方，在本例中。此外，您可以通过使用反向追加，而不是反转(reduce 'append (nreverse parts) :from-end t)，来做一些比parts更有效的事情。例如，

(flet ((xappend (l2 l1)
         (append l1 l2)))
  (reduce #'xappend '((5 6) (x y) (3 4) (x y))))
;=> (x y 3 4 x y 5 6)

我写这篇文章的风格有点命令式，但如果你想要的话，没有理由不能使用函数式风格。请注意，并非所有Lisp实现都支持尾调用优化，因此使用do可能更好，但您当然不必这么做。下面是一个更实用的版本：

(defun splice-replace-list (old new list)
  (let ((new-list (coerce new 'list))
        (old-len (length old)))
    (labels ((keep-going (list parts)
               (if (endp list)
                   (reduce 'append (nreverse parts) :from-end t)
                   (let* ((pos (search old list))
                          (parts (list* (subseq list 0 pos) parts)))
                     (if (null pos)
                         (keep-going '() parts)
                         (keep-going (nthcdr (+ old-len pos) list)
                                     (list* new-list parts)))))))
      (keep-going list '()))))

向量的版本

对于非列表，这更困难，因为您没有应该用于结果的特定序列类型。这就是为什么像concatenate这样的函数需要一个结果类型的参数。您可以使用array-element-type来获取输入序列的元素类型，然后使用make-array获取足以容纳结果的序列。这是更复杂的代码，而且会更复杂。这是第一次尝试。这更复杂，但您将得到一个非常接近于原始向量类型的结果：

(defun splice-replace-vector (old new vector &aux (new-len (length new)))
  (flet ((assemble-result (length parts)
           (let ((result (make-array length :element-type (array-element-type vector)))
                 (start 0))
             (dolist (part parts result)
               (cond
                 ((consp part)
                  (destructuring-bind (begin . end) part
                    (replace result vector :start1 start :start2 begin :end2 end)
                    (incf start (- end begin))))
                 (t
                  (replace result new :start1 start)
                  (incf start new-len)))))))
    (do ((old-len (length old))
         (total-len 0)
         (start 0)
         (indices '()))
        ((null start) (assemble-result total-len (nreverse indices)))
      (let ((pos (search old vector :start2 start)))
        (cond 
          ((null pos)
           (let ((vlength (length vector)))
             (push (cons start vlength) indices)
             (incf total-len (- vlength start))
             (setf start nil)))
          (t
           (push (cons start pos) indices)
           (push t indices)
           (incf total-len (- pos start))
           (incf total-len new-len)
           (setf start (+ pos old-len))))))))

CL-USER> (splice-replace-vector '(#\z) '(#\x #\y) "12z")
"12xy"
CL-USER> (splice-replace-vector '(z) '(x y) #(x y))
#(X Y)
CL-USER> (splice-replace-vector '(z) '(x y) #(1 z 2 z 3 4 z))
#(1 X Y 2 X Y 3 4 X Y)
CL-USER> (splice-replace-vector '(#\z) #(#\x #\y) "1z2z34z")
"1xy2xy34xy"

如果您只想通过输入向量进行一次传递，那么您可以使用一个可调整的数组作为输出，并将其附加到其中。可调整数组的开销将比固定大小的数组稍微多一点，但它确实使代码变得更简单。

(defun splice-replace-vector (old new vector)
  (do ((vlength (length vector))
       (vnew (coerce new 'vector))
       (nlength (length new))
       (result (make-array 0
                           :element-type (array-element-type vector)
                           :adjustable t
                           :fill-pointer 0))
       (start 0))
      ((eql start vlength) result)
    (let ((pos (search old vector :start2 start)))
      (cond
        ;; add the remaining elements in vector to result
        ((null pos)
         (do () ((eql start vlength))
           (vector-push-extend (aref vector start) result)
           (incf start)))
        ;; add the elements between start and pos to the result, 
        ;; add a copy of new to result, and increment start
        ;; accordingly
        (t 
         ;; the copying here could be improved with adjust-array,
         ;; and replace, instead of repeated calls to vector-push-extend
         (do () ((eql start pos))
           (vector-push-extend (aref vector start) result)
           (incf start))
         (loop for x across vnew
            do (vector-push-extend x result))
         (incf start (1- nlength)))))))

“通用”版本

使用这两个函数，您可以定义一个通用splice-replace，它检查原始输入序列的类型并调用适当的函数：

(defun splice-replace (old new sequence)
  (etypecase sequence
    (list   (splice-replace-list   old new sequence))
    (vector (splice-replace-vector old new sequence))))

CL-USER> (splice-replace #(z) '(x y) #(1 z 2 z 3 4 z))
#(1 X Y 2 X Y 3 4 X Y)
CL-USER> (splice-replace '(z) #(x y) '(1 z 2 z 3 4 z))
(1 X Y 2 X Y 3 4 X Y)