Mic*_*lle 3 lisp list generator permutation common-lisp
我已经有了生成元素列表的所有排列的代码。然而，我意识到，如果我想操作生成的列表，我需要遍历这个列表。该列表可能会很大，因此维护成本很高。我想知道是否有一种方法可以通过每次调用生成排列，以便我可以检查列表是否与我需要的匹配，如果不匹配，我将生成下一个排列。（每次该函数都会一次返回一个列表。）
我的代码：
(defun allPermutations (list)
(cond
((null list) nil)
((null (cdr list)) (list list))
(t (loop for element in list
append (mapcar (lambda (l) (cons element l))
(allPermutations (remove element list)))))))
假设您有以下range函数：
(defun range (start end &optional (step 1))
(loop for x from start below end by step collect x))
您可以接受另一个参数，一个函数，并为每个元素调用它：
(defun range-generator (callback start end &optional (step 1))
(loop for x from start below end by step do (funcall callback x)))
这使调用者可以控制迭代过程：
(block root
(range-generator (lambda (v)
(print v)
(when (>= v 10)
(return-from root)))
0 300))
0
1
2
3
4
5
6
7
8
9
10
如果您想避免分配太多内存，您可以安排代码分配一次中间数据结构，并在每次调用回调时重用它们。这是一个带注释的示例：
(defun permutations% (list callback)
(when list
(let* (;; Size of input list
(size (length list))
;; EMPTY is a sentinel value which is guaranteed to
;; never be equal to any element from LIST.
(empty (gensym "SENTINEL"))
;; Working vector containing elements from LIST, or
;; EMPTY. This vector is mutated to remember which
;; element from the input LIST was already added to the
;; permutation.
(items (make-array size :initial-contents list))
;; Working vector containing the current
;; permutation. It contains a FILL-POINTER so that we
;; can easily call VECTOR-PUSH and VECTOR-POP to
;; add/remove elements.
(permutation (make-array (length items) :fill-pointer 0)))
;; Define a local recursive function named POPULATE, which
;; accepts a COUNT argument. The count starts at SIZE and
;; decreases at each recursive invocation, allowing the
;; function to know when it should end.
(labels ((populate (count)
(if (plusp count)
;; Loop over ITEMS by index
(dotimes (item-index size)
(let ((item (svref items item-index)))
;; We found an ITEM which is not yet
;; present in PERMUTATION.
(unless (eq item empty)
;; Push that element
(vector-push item permutation)
;; Replace current value in ITEMS by EMPTY
(setf (svref items item-index) empty)
;; POPULATE will recursively populate
;; the remaining elements in
;; PERMUTATION and call CALLBACK. Once
;; it is done, it will return here.
(populate (1- count))
;; There are other items to process in
;; current loop. Reset the state to how
;; it was before calling POPULATE.
;; Replace the EMPTY value by the
;; original ITEM at current index.
(setf (svref items item-index) item)
;; Remove ITEM from PERMUTATION.
(vector-pop permutation))))
;; We filled PERMUTATION with SIZE elements.
;; Call CALLBACK with PERMUTATION. Note: the
;; callback function is always given the same
;; vector, but its content changes over
;; time. The value passed to CALLBACK is thus
;; valid only during the time we are
;; executing CALLBACK. If the caller needs to
;; keep a copy of the current permutation, it
;; should COPY-LIST the value.
(funcall callback permutation))))
;; Initiate recursive function with current SIZE.
(populate size)))))
该函数接受一个列表和一个回调，这是一个接受一个参数（当前排列）的函数。请注意，此参数仅在调用的动态范围内有效，因为一旦调用返回，传递给回调的相同数据结构就会被修改。
如上所述，您可以调用任何函数，特别是引用词法环境中其他变量的闭包。这里，匿名 lambda 递增count变量，这允许计算排列的数量，而无需将它们存储在列表中并获取列表的大小：
(time
(let ((count 0))
(permutations% '(a b c d e f g h i j k) (lambda (p) (incf count)))
count))
=> 39916800
Evaluation took:
6.455 seconds of real time
6.438200 seconds of total run time (6.437584 user, 0.000616 system)
99.74% CPU
17,506,444,509 processor cycles
0 bytes consed
在上面的报告中，0 bytes consed表示分配的内存的大致数量（不包括堆栈分配）。您还可以提供该函数的更安全版本，该函数在将每个排列发送到回调函数之前复制每个排列。
(defun permutations (list callback)
(permutations% list (lambda (permutation)
(funcall callback (coerce permutation 'list)))))
另请参阅Will Ness 的答案，它设法用列表处理剩余元素集，从而避免了过滤 EMPTY 元素的需要。
这是一种方法（遵循@coredump的答案中的代码结构；在 tio.run 上运行速度大约快 4 倍）：
(defun permutations (list callback)
(if (null list)
(funcall callback #())
(let* ((all (cons 'head (copy-list list))) ; head sentinel FTW!
(perm (make-array (length list))))
(labels
((g (p i &aux (q (cdr p))) ; pick all items in arbitrary order:
(cond
((cdr q) ; two or more items left:
(loop while q do ; for each item in q:
(setf (svref perm i) (car q)) ; grab the item
(rplacd p (cdr q)) ; pluck it out
(g all (1+ i)) ; get the rest!
(rplacd p q) ; then, put it back
(pop p) ; and advance
(pop q))) ; the pointers
(T ; one last item left in q:
(setf (svref perm i) (car q)) ; grab the last item
(funcall callback perm))))) ; and call the callback
(g all 0)))))
测试：
; [20]> (permutations '(1 2 3) #'(lambda (x) (princ x) (princ #\ )))
; #(1 2 3) #(1 3 2) #(2 1 3) #(2 3 1) #(3 1 2) #(3 2 1)
; [58]> (let ((acc (list))) (permutations '(1 2 3) #'(lambda (x)
; (push (coerce x 'list) acc))) (reverse acc))
; ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
; [59]> (let ((acc (list))) (permutations '() #'(lambda (x)
; (push (coerce x 'list) acc))) (reverse acc))
; (NIL)
这在运行时使用递归为n长输入列表构建n 嵌套循环计算结构，每个嵌套循环中的固定 i = 0, 1, ..., n-1是结果中的位置 -保存utation数组以将选取的项目放入 中。当数组中的所有n个位置都被填充时，一旦我们进入最里面的循环（它甚至不再是一个循环，因为它只剩下一个元素需要处理），用户提供的回调就会被调用数组作为其参数。每个新排列都会重复使用该数组。permperm
实现“收缩域”范例，如以下具有列表拼接和模式匹配的高级伪代码所示：
; [20]> (permutations '(1 2 3) #'(lambda (x) (princ x) (princ #\ )))
; #(1 2 3) #(1 3 2) #(2 1 3) #(2 3 1) #(3 1 2) #(3 2 1)
; [58]> (let ((acc (list))) (permutations '(1 2 3) #'(lambda (x)
; (push (coerce x 'list) acc))) (reverse acc))
; ((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
; [59]> (let ((acc (list))) (permutations '() #'(lambda (x)
; (push (coerce x 'list) acc))) (reverse acc))
; (NIL)
（其中splits，列表生成所有可能的子列表对，这些子列表附加在一起，重新构成列表；特别是splits [] = [ [[],[]] ]和splits [1] = [ [[],[1]] , [[1],[]] ]）；或者，在一个简单的命令式伪代码中，
for item1 in list:
domain2 = remove item1 from list by position
for item2 in domain2:
domain3 = remove item2 from domain2 by position
for item3 in domain3:
......
......
for item_n in domain_n:
(callback
(make-array n :initial-contents
(list item1 item2 ... item_n)))
但在实际代码中，我们通过外科手术操作列表结构，完全消除了该伪代码使用的所有二次临时存储。链表的唯一优点是它们的O(1) 节点删除能力；我们不妨用它！
更新：对排列的最后两个元素进行特殊处理（通过将最后一个循环展开到相应的两个回调调用中）可提供约 1.5 倍的额外加速。
（如果TIO 链接失效，这里有一个包含工作代码的Pastebin ，或者github gist。）
更新：这种技术称为递归回溯，通过递归创建n嵌套循环回溯计算结构。