我经常需要将某些元素的子序列替换为相同类型的另一个序列，但可能具有不同的长度。实现这样的功能不是挑战，这就是我现在使用的：
(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)))
答案 0 :(得分：5)
我不认为这有任何标准功能。它比标准的replace函数族更复杂。那些可以破坏性地操作，因为你事先知道你可以逐个元素地替换。即使在这种情况下，有效地执行此操作仍然有些困难，因为列表和向量的访问时间非常不同，因此像subseq这样的通用函数可能会有问题。正如Rainer Joswig pointed out in a comment：
很遗憾，对于序列中的许多算法而言 没有单一的有效实施。我经常看到有两个 版本，一个用于列表，一个用于向量，然后隐藏 在调度功能背后。对于黑客来说，一个简单的通用版本是 很好，但对于图书馆的功能，往往有不同 实现 - 如此处所示。
（事实上，在对某个库是否包含此函数进行一些研究时，我得到的第一个Google结果之一是关于Code Review的问题Generic sequence splitter in Common Lisp，其中Rainer和我都是有一些类似于这里的评论。）
但是，您的实现效率相当低，因为它会生成序列剩余部分的多个副本。例如，当您使用(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)时复制它。你可能会更好地完成对序列的一次传递，确定要替换的子序列的索引，或者收集需要替换不的位等等。你＆＃ 39; ll可能想要列表和其他序列的单独实现。例如，您可以使用列表：
(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)