Function 替换子序列的标准函数

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

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

你看，它非常方便和有用，所以我觉得我正在重新发明轮子，它一定在标准库中，我只是不知道它的名称（有时名称不明显，你可以搜索

过滤器

，而你需要的是

设置差异

）

由于清晰性和效率之间的折衷：

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

---

我不认为这有任何标准的功能。它比标准的

replace

函数族更复杂。这些可以破坏性地运行，因为您事先知道可以逐个元素替换。即使在这种情况下，也很难有效地做到这一点，因为列表和向量的访问时间非常不同，因此像

subseq

这样的通用函数可能会有问题。作为：

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

（事实上，在做一些关于某个库是否包含此函数的研究时，我得到的第一个谷歌结果之一是关于代码审查的问题，我和雷纳在其中都有一些类似于这里的评论。）

列表的一个版本 然而，您的实现效率相当低，因为它会生成序列剩余部分的多个副本。例如，当您将

（1 z 2 z 3 z）

中的

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

如果您愿意，可以在这里进行一些优化。例如，您可以实现一个

搜索列表

，该列表不返回搜索序列的第一个实例的位置，而是返回一个头部向上的副本，直到该点，尾部以序列为多个值开始，甚至返回复制的头部和序列后的尾部，因为这才是你真正感兴趣的，在这种情况下。此外，通过不反转

部分，而是使用反转的追加，您可以做一些比
（reduce'append（nreverse parts）：从t端开始）
更有效的事情。例如：

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

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

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

“通用”版本
使用这两个函数，您可以定义一个常规的
拼接替换
，用于检查原始输入序列的类型并调用相应的函数：

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

为什么要使用funcall+alambda，而不是普通的
标签
？此外，您正在使用递归+连接。看起来像是很多中间垃圾。如果使用
lambda
使事情变得更短、更方便，为什么不使用
alambda
呢？我认为
alambda
看起来更好，嵌套更少。中间垃圾怎么办。。我们在LISP中有垃圾收集器，不是吗？我的代码是危险的还是坏的？如果生成的字符串比原始字符串短，可以使用
replace
（以及
copy seq
，如果您不希望函数具有破坏性，则可以使用
concatenate
和
subseq
@Rörd，可能有错误。@Rörd如果要“拼接”的序列与要替换的子序列长度相同，则替换和复制序列是绝对正确的，但我认为情况并非如此，因为“我需要用另一个相同类型的序列替换某些元素的子序列，但可能长度不同”.我想写一个函数，以同样的方式处理所有类型的序列。这就是为什么我使用了
concatenate
，但我不知道它会复制每个参数。现在我要考虑改进我原来的功能。@Mark，我并不是以一种居高临下的方式说这句话，但它还能起什么作用呢？如果您
（concatenate'list“123”“abc”）
，您将得到一个列表，因此它必须是新的（因为参数是字符串）。如果您
（将'string'123'连接到'abc'
(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)