macros - 如何在 lisp 中编写 'destructive' dolist 宏

Question

我正在尝试以最直观的方式在 Common Lisp(也适用于 Emacs Lisp)中编写一个简单的冒泡排序:

(defun bubble-sort-long (list)
  (labels ((rec (list acc)
                (if (null list) (nreverse acc)
                    (progn
                      (dolist (x (cdr list))
                        (if (< x (car list))
                            (rotatef x (car list))))
                      (rec (cdr list) (push (car list) acc))))))
           (rec list nil)))

这行不通。因为rotatef只是交换临时变量x和(car list)的值，而不交换列表中被比较的元素。跟踪结果如下:

>(setf a '(1 3 2 5 4))
>(trace bubble-sort)
>(bubble-sort a)
  0: (BUBBLE-SORT-LONG (1 3 2 5 4))
  0: BUBBLE-SORT-LONG returned (1 2 2 4 4)

我想最直接的解决方法是定义一个“破坏性”的 dolist 宏，它分配一个 x 直接指向到列表中的迭代元素。类似于 ndolist 的东西，这样我就可以完成以下工作:

(setf a '(1 2 3))
(ndolist (x a)
  (setf x (+ 1 x)))  

将产生:(2 3 4)。

另外，如果大家能提供更直观的使用lisp进行冒泡排序的思路，也请指点。

在 ruby​​ 中，类似的算法是这样的:

class Array
  def bubble_sort
    self.each_with_index do |a,j|
      i=j+1
      while i<self.length
        if (self[j]>self[i])
          self[j],self[i]=self[i],self[j]
        end
        i=i+1
      end
    end
  end

有趣的是我仍然必须使用“并行赋值”来交换值。 Ruby 不支持(鼓励)通过 C/C++ 风格的引用来交换临时变量。

Answer 1

关于您的原始问题:所以您需要一个 dolist 变体，它不仅将迭代变量绑定(bind)到提供的名称，而且使它成为一个位置。应该可以通过将该宏扩展到 symbol-macrolet 的循环中来实现，这将在每个迭代步骤中将名称扩展为不同的位置形式。

关于冒泡排序的实现:冒泡排序无论如何都是非常低效的，所以麻烦尾递归是一种能源浪费。如果您完全关心效率，您可以选择更好的算法，冒泡排序仅用于演示目的，因此您应该尽可能坚持使用伪代码实现。这是执行此操作的 lisp 实现:

(defun bubble-sort (seq)
  (loop for n from (length seq) downto 2 and swapped = nil
     do (dotimes (i (1- n))
          (when (> (elt seq i) (elt seq (1+ i)))
            (rotatef (elt seq i) (elt seq (1+ i)))
            (setf swapped t)))
     while swapped))

此实现的另一个好处是它使用序列协议(protocol)，因此它适用于列表和向量(一维数组)。

编辑:正如评论中所讨论的那样，在列表上使用序列协议(protocol)的随机访问操作效率非常低，所以这是一个避免它们的版本(它的缺点是它不再适用于向量):

(defun list-bubble-sort (list)
  (when list
    (loop with result = ()
       for swapped = nil
       do (let ((x (car list)))
            (setf list (loop for y in (cdr list)
                          when (> x y) collect y and do (setf swapped t)
                          else collect x and do (setf x y)))
            (push x result))
       unless (and list swapped) return (append list result))))

此版本返回排序列表并且不改变原始列表。