Mar*_*ark 3 lisp replace function common-lisp sequence
通常我需要用相同类型的另一个序列替换某些元素的子序列,但是,可能具有不同的长度.实现这样的功能不是挑战,这就是我现在使用的:
(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)))
我不认为这有任何标准功能.它比标准replace的功能系列更复杂.那些可以破坏性地操作,因为你事先知道你可以逐个元素地替换.即使在这种情况下,有效地执行此操作仍然有些困难,因为列表和向量的访问时间非常不同,因此通用功能subseq可能会出现问题.正如Rainer Joswig在评论中指出的那样:
令人遗憾的是,对于序列上的许多算法而言,没有单一的有效实现.我经常看到有两个版本,一个用于列表,一个用于向量,然后隐藏在调度函数后面.对于hack,一个简单的通用版本很好,但对于库函数,通常有不同的实现 - 如此处所示.
(事实上,在对某个库是否包含此函数进行一些研究时,我得到的第一个Google结果之一是关于Code Lis的问题,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).您可能是在序列做一个传球更好,确定子序列的指数来代替,或收集需要的位并不需要更换,等等.你可能会想列表和单独实现其他序列.例如,使用列表,您可能会:
(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)