我想问一下如何将两个不同的数字列表合并到一个新的列表中，在Common Lisp中保持它们之间的“共同点”。
实施例
list1：（1 2 3 2 2）
清单2：（1/2 1/2 1 2 2 1 2 1）
结果：（1/2 1/2 1 1 1 2 1 1 1 1）
我希望下面的图片可以准确描述问题。 列表是数字，因为它必须比较两个系列的不同单位，并进一步将两个系列的每个数字的起点分成新的系列。
Image_1. I think this image is the best way to describe the problem.
答案 0 :(得分：0)
根据你的描述，我写了两个相互递归的函数MRG和SPLIT：
以下是显示如何计算结果的执行跟踪。
0: (MRG (1 2 3 2 2) (1/2 1/2 1 2 2 1 2 1))
1: (SPLIT 1 (1/2 1/2 1 2 2 1 2 1) (2 3 2 2))
2: (SPLIT 1/2 (1/2 1 2 2 1 2 1) (2 3 2 2))
3: (SPLIT 0 (1 2 2 1 2 1) (2 3 2 2))
4: (MRG (2 3 2 2) (1 2 2 1 2 1))
5: (SPLIT 2 (1 2 2 1 2 1) (3 2 2))
6: (SPLIT 1 (2 2 1 2 1) (3 2 2))
7: (SPLIT 0 (1 2 1 2 1) (3 2 2))
8: (MRG (3 2 2) (1 2 1 2 1))
9: (SPLIT 3 (1 2 1 2 1) (2 2))
10: (SPLIT 2 (2 1 2 1) (2 2))
11: (SPLIT 0 (1 2 1) (2 2))
12: (MRG (2 2) (1 2 1))
13: (SPLIT 2 (1 2 1) (2))
14: (SPLIT 1 (2 1) (2))
15: (SPLIT 0 (1 1) (2))
16: (MRG (2) (1 1))
17: (SPLIT 2 (1 1) NIL)
18: (SPLIT 1 (1) NIL)
19: (SPLIT 0 NIL NIL)
20: (MRG NIL NIL)
20: MRG returned NIL
19: SPLIT returned NIL
18: SPLIT returned (1)
17: SPLIT returned (1 1)
16: MRG returned (1 1)
15: SPLIT returned (1 1)
14: SPLIT returned (1 1 1)
13: SPLIT returned (1 1 1 1)
12: MRG returned (1 1 1 1)
11: SPLIT returned (1 1 1 1)
10: SPLIT returned (2 1 1 1 1)
9: SPLIT returned (1 2 1 1 1 1)
8: MRG returned (1 2 1 1 1 1)
7: SPLIT returned (1 2 1 1 1 1)
6: SPLIT returned (1 1 2 1 1 1 1)
5: SPLIT returned (1 1 1 2 1 1 1 1)
4: MRG returned (1 1 1 2 1 1 1 1)
3: SPLIT returned (1 1 1 2 1 1 1 1)
2: SPLIT returned (1/2 1 1 1 2 1 1 1 1)
1: SPLIT returned (1/2 1/2 1 1 1 2 1 1 1 1)
0: MRG returned (1/2 1/2 1 1 1 2 1 1 1 1)
我没有尝试优化代码，我只是尝试以能够产生有用跟踪的方式正常工作。但这看起来像循环也可能起作用。
这是一个没有递归和调试语句的版本：
(defun mrg% (lx ly)
(with-list-collector (collect)
(flet ((collect (v)
"Add print statements to COLLECT"
(print (list :collect v))
(collect v)))
(dolist (x lx)
(loop
(print (list :split x ly))
(unless (plusp x)
(return))
(assert ly)
(let ((y (pop ly)))
(if (<= y x)
(decf x (collect y))
(return (push (- y (collect x)) ly)))))))))
用你的例子：
(mrg% '(1 2 3 2 2 )
'(1/2 1/2 1 2 2 1 2 1))
...打印：
(:SPLIT 1 (1/2 1/2 1 2 2 1 2 1))
(:COLLECT 1/2)
(:SPLIT 1/2 (1/2 1 2 2 1 2 1))
(:COLLECT 1/2)
(:SPLIT 0 (1 2 2 1 2 1))
(:SPLIT 2 (1 2 2 1 2 1))
(:COLLECT 1)
(:SPLIT 1 (2 2 1 2 1))
(:COLLECT 1)
(:SPLIT 3 (1 2 1 2 1))
(:COLLECT 1)
(:SPLIT 2 (2 1 2 1))
(:COLLECT 2)
(:SPLIT 0 (1 2 1))
(:SPLIT 2 (1 2 1))
(:COLLECT 1)
(:SPLIT 1 (2 1))
(:COLLECT 1)
(:SPLIT 2 (1 1))
(:COLLECT 1)
(:SPLIT 1 (1))
(:COLLECT 1)
(:SPLIT 0 NIL)
为了完整性，这是我正在使用的宏：
(defmacro with-list-collector
((collector-name &optional name copy-p) &body body)
"Bind COLLECTOR-NAME as a local function to collect items in a list.
A call to (COLLECTOR-NAME VALUE) accumulates VALUE into a list, in the
same order as the calls are being made. The resulting list can be
accessed through the symbol NAME, if given, or as the return value of
WITH-LIST-COLLECTOR.
The return value of (COLLECTOR-NAME VALUE) is VALUE.
If COPY-P is T, each access to NAME performs a copy of the list under
construction. Otherwise, NAME refers to a list which last cons-cell is
modified after each call to COLLECTOR-NAME (except if it is NIL).
The return value of the whole form is the list being built, ONLY when
NAME is NIL. Otherwise, the return value is given by the last form of
BODY: it is assumed that the list will be accessed by NAME if
necessary, and that the interesting value is given by BODY."
(assert (or (not copy-p) name) ()
"A COPY argument is only valid when a NAME is given.")
(alexandria:with-gensyms (queue head value)
(let ((flet-expr `(flet ((,collector-name (,value)
(prog1 ,value
(setf ,queue
(setf (cdr ,queue)
(cons ,value nil))))))
(declare (inline ,collector-name))
,@body)))
`(let* ((,queue (cons nil nil))
(,head ,queue))
,(if name
`(symbol-macrolet
((,name ,(if copy-p
`(copy-seq (cdr ,head))
`(cdr ,head))))
,flet-expr)
;; anonymous list : return as result
`(progn ,flet-expr
(cdr ,head)))))))
答案 1 :(得分：0)
在我看来，列表元素就像是节拍之间的暂停。我的算法会在每一步查找最小暂停，然后减少剩余的当前暂停，并在当前暂停为零时推进列表。
为了说明，我将一条打印指令放入循环中：
(defun merge-beats (&rest lists)
(do* ((minpause nil (reduce #'min (mapcar #'first pauses)))
(result () (cons minpause result))
(pauses lists
(remove nil
(mapcar (lambda (pause-list)
(let ((current-pause (- (first pause-list)
minpause)))
(if (zerop current-pause)
(rest pause-list)
(cons current-pause
(rest pause-list)))))
pauses)))
(- #1=(print (list :minpause minpause :result result :pauses pauses))
#1#))
((endp pauses) (nreverse result))))
CL-USER> (merge-beats '(1 2 3 2 2)
'(1/2 1/2 1 2 2 1 2 1))
(:MINPAUSE NIL :RESULT NIL :PAUSES ((1 2 3 2 2) (1/2 1/2 1 2 2 1 2 1)))
(:MINPAUSE 1/2 :RESULT (1/2) :PAUSES ((1/2 2 3 2 2) (1/2 1 2 2 1 2 1)))
(:MINPAUSE 1/2 :RESULT (1/2 1/2) :PAUSES ((2 3 2 2) (1 2 2 1 2 1)))
(:MINPAUSE 1 :RESULT (1 1/2 1/2) :PAUSES ((1 3 2 2) (2 2 1 2 1)))
(:MINPAUSE 1 :RESULT (1 1 1/2 1/2) :PAUSES ((3 2 2) (1 2 1 2 1)))
(:MINPAUSE 1 :RESULT (1 1 1 1/2 1/2) :PAUSES ((2 2 2) (2 1 2 1)))
(:MINPAUSE 2 :RESULT (2 1 1 1 1/2 1/2) :PAUSES ((2 2) (1 2 1)))
(:MINPAUSE 1 :RESULT (1 2 1 1 1 1/2 1/2) :PAUSES ((1 2) (2 1)))
(:MINPAUSE 1 :RESULT (1 1 2 1 1 1 1/2 1/2) :PAUSES ((2) (1 1)))
(:MINPAUSE 1 :RESULT (1 1 1 2 1 1 1 1/2 1/2) :PAUSES ((1) (1)))
(:MINPAUSE 1 :RESULT (1 1 1 1 2 1 1 1 1/2 1/2) :PAUSES NIL)
(1/2 1/2 1 1 1 2 1 1 1 1)
CL-USER>