arrays - 更好的排列生成算法

Question

这里有一些我可以想出的，但我对其中任何一个都不满意:

(defsubst i-swap (array a b)
  (let ((c (aref array a)))
    (aset array a (aref array b))
    (aset array b c) array))

(defun i-permute-recursive (array offset length)
  (if (= offset length)
      (message "array: %s" array)
    (let ((i offset))
      (while (< i length)
        (i-permute-recursive (i-swap array i offset) (1+ offset) length)
        (i-swap array i offset)
        (incf i)))))

(defun i-permute-johnson-trotter (array)
  (let ((i 0) largest largest-pos largest-sign swap-to
        (markers (make-vector (length array) nil)))
    (while (< i (length array))
      (aset markers i (cons '1- i))
      (incf i))
    (setcar (aref markers 0) nil)
    (while (some #'car markers)
      (setq i 0 largest nil)
      (while (< i (length array))
        (destructuring-bind (tested-sign . tested-value)
            (aref markers i)
          (when (and tested-sign
                     (or (not largest)
                         (< largest tested-value)))
            (setq largest tested-value largest-pos i
                  largest-sign tested-sign)))
        (incf i))
      (when largest
        (setq swap-to (funcall largest-sign largest-pos))
        (i-swap array largest-pos swap-to)
        (i-swap markers largest-pos swap-to)
        (when (or (= swap-to 0) (= swap-to (1- (length array)))
                  (> (cdr (aref markers
                                (funcall largest-sign swap-to)))
                     largest))
          (setcar (aref markers swap-to) nil))
        (setq i 0)
        (while (< i (length array))
          (setq swap-to (cdr (aref markers i)))
          (when (> swap-to largest)
            (setcar (aref markers i)
                    (if (< i largest-pos) '1+ '1-)))
          (incf i))
        (message "array: %s <- makrers: %s" array markers)))))

递归变体都进行了额外的交换，而且它是递归的，这让我非常不高兴(我不关心堆栈的大小，因为我关心的是调试的方便性——递归函数在调试器中看起来很糟糕……)

我根据 Wiki 上的描述实现的另一个版本，如果您有兴趣，请点击此处:http://en.wikipedia.org/wiki/Steinhaus%E2%80%93Johnson%E2%80%93Trotter_algorithm但是它太长了(只是代码本身很长)而且它或多或少是 O(n*m)，对于短数组来说几乎就像二次方。 (m为数组长度，n为排列数。)

从递归版本来看，我希望一定有一个*普通* O(n) 变体，但我就是无法理解它...

如果你觉得用另一个 Lisp 编写它更舒服，欢迎你!

Answer 1

这就是我现在得到的，多亏了这个博客:http://www.quickperm.org/

(defun i-permute-quickperm (array)
  (let* ((len (length array))
         (markers (make-vector len 0))
         (i 1) j)
    (while (< i len)
      (if (< (aref markers i) i)
          (progn
            (setq j (if (oddp i) (aref markers i) 0))
            (i-swap array j i)
            (message "array: %s" array)
            (aset markers i (1+ (aref markers i)))
            (setq i 1))
        (aset markers i 0)
        (incf i)))))

但请随时提出更好的建议。 (虽然这对我来说看起来很漂亮，所以 idk :P)