如何在Lisp中一次生成一个列表中元素的所有排列?

时间:2018-04-16 02:49:40

标签: list lisp generator permutation

我已经有了代码来生成元素列表的所有排列。但是,我意识到如果我想操纵生成的列表,我需要遍历此列表。这个列表可能很大,因此保持昂贵。我想知道是否有办法通过每次调用生成排列,以便我可以检查列表是否与我需要的匹配,如果不匹配,我将生成下一个排列。 (每次该函数将一次返回一个列表。)

我的代码:

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

2 个答案:

答案 0 :(得分:2)

一般原则

假设您有以下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

请参阅RETURNBLOCK

排列组合

如果您想避免分配太多内存,可以安排代码分配中间数据结构一次,并在每次调用回调时重复使用它们。这是一个带注释的例子:

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

该函数接受一个列表和一个回调,它是一个接受一个参数的函数,即当前的排列。请注意,此参数仅在回调的生命周期dynamic extent)期间有效。

如上所述,您可以调用任何函数,特别是在词汇环境中引用其他变量的闭包。在这里,匿名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字节consed 表示分配的大致内存数(不计算堆栈分配)。 您还可以提供更安全的函数版本,在将每个排列发送到回调函数之前复制每个排列。

(defun permutations (list callback)
  (permutations% list (lambda (permutation)
                        (funcall callback (coerce permutation 'list)))))

另见

另请参阅the answer from Will Ness,它设法使用列表处理剩余元素集,从而避免过滤EMPTY元素。

答案 1 :(得分:2)

这是一种方式(遵循来自@coredumptheir answer的代码结构;在tio.run上运行速度提高约4倍):

(defun permutations (list callback)
  (when list
    (let* ((all (cons 'head (copy-list list)))           ; head sentinel FTW!
           (perm (make-array (length list))))
      (labels ((g (p i &aux (q (cdr p)))
                (cond
                  ((null (cdr q))   
                     (setf (svref perm i) (car q))       ; the last item
                     (funcall callback perm))
                  (T (loop while q do 
                        (setf (svref perm i) (car q))    ; pick the item
                        (rplacd p (cdr q))               ; pluck it out
                        (g all (1+ i))                   ; recurse!
                        (rplacd p q)                     ; heal the list back
                        (pop p)  
                        (pop q))))))                     ; advance the pointers
        (g all 0))))) 

; > (permutations '(1 2 3) #'princ)
; #(1 2 3)#(1 3 2)#(2 1 3)#(2 3 1)#(3 1 2)#(3 2 1)

这使用递归在运行时为 n -long输入列表构建 n嵌套循环结构,其中固定的 i = 0,1每个嵌套循环中的,...,n-1 是结果保持perm utation数组中放置拾取项的位置。当数组中的所有 n 位置都被填充时,在最里面的循环中(因为它只有一个元素需要处理,它甚至不再是一个循环),用户提供的回调被称为。

实施"缩小域名"像这个伪代码那样的范例:

for item1 in list:
   domain2 = remove item1 from list by position
   for item2 in domain2:
      domain3 = remove item2 domain2 by position
      for item3 in domain3:
             ......
             ......
             (callback (list item1 item2 ... item_n))

但是在the real code中,我们通过手术操作列表结构来消除此伪代码使用的所有二次临时存储,完全。关于链表的唯一优势是它们的 O(1)节点删除功能;我们不妨使用它!

更新:特殊包装排列的最后两个元素,并提供约1.5倍的额外加速。