如何删除Lisp代码中的冗余？

Question

我试图想出快速排序Common Lisp中的实现，这是我这么远：

(defun quick-sort (list) 
    (if (cdr list) 
    (let ((pivot (car list))) 
     (append (quick-sort (remove-if-not (lambda (n) (< n pivot)) list)) 
       (remove-if-not (lambda (n) (= n pivot)) list) 
       (quick-sort (remove-if-not (lambda (n) (> n pivot)) list)))) 
    list)) 

显然，它的工作原理，但我觉得有太多的重复在码。基本上，我们有三次：

(remove-if-not (lambda (n) (< n pivot)) list) 

三个不同的调用的唯一方法是通过> VS = VS <。

因此，我的问题是：我如何删除冗余，使代码更具可读性和更紧凑？

我当然可以提取的东西的功能，如：

(defun which (operator pivot list) 
    (remove-if-not (lambda (n) (funcall operator n pivot)) list)) 

(defun quick-sort (list) 
    (if (cdr list) 
    (let ((pivot (car list))) 
     (append (quick-sort (which #'< pivot list)) 
       (which #'= pivot list) 
       (quick-sort (which #'> pivot list)))) 
    list)) 

但不知何故，我真的不相信这是最好的办法。它仍然感到笨拙，必须一次又一次地交出pivot和list。

我也有想法，使用flet，这使得该功能的实际身体更具可读性，但只有移动的复杂性到别的地方：

(defun quick-sort (list) 
    (if (cdr list) 
    (let ((pivot (car list))) 
     (flet ((left() (remove-if-not (lambda (n) (< n pivot)) list)) 
      (middle() (remove-if-not (lambda (n) (= n pivot)) list)) 
      (right() (remove-if-not (lambda (n) (> n pivot)) list))) 
     (append (quick-sort (left)) 
       (middle) 
       (quick-sort (right))))) 
    list)) 

任何其他方法？

Answer 1

如果将它作为本地函数编写，则不必传递额外的参数，因为它们在范围内。

(defun quick-sort (list) 
    (if (rest list) 
     (let ((pivot (first list))) 
     (flet ((filter (operator) 
       (remove-if-not (lambda (n) (funcall operator n pivot)) list))) 
      (append (quick-sort (filter #'<)) 
        (filter #'=) 
        (quick-sort (filter #'>))))) 
    list)) 

稍微更紧凑的版本：

(defun quick-sort (list &aux (pivot (first list))) 
    (flet ((filter (operator) 
      (remove-if-not (lambda (n) (funcall operator n pivot)) list))) 
    (and list 
     (nconc (quick-sort (filter #'<)) 
       (filter #'=) 
       (quick-sort (filter #'>)))))) 

由于Common Lisp中支持多个值，你也可以在一个功能一气呵成分区列表，并返回列表的值：

(defun partition (list pivot) 
    (loop for e in list 
     when (< e pivot) collect e into smaller else 
     when (> e pivot) collect e into larger else 
     when (= e pivot) collect e into same 
     finally (return (values smaller same larger)))) 

(defun quick-sort (list) 
    (if (rest list) 
     (multiple-value-bind (smaller same larger) 
      (partition list (first list)) 
     (append (quick-sort smaller) same (quick-sort larger))) 
    list)) 

当列表刚被分配时，则NCONC是可能的。由于REMOVE-IF-NOT是非破坏性的（与DELETE-IF-NOT比较），NCONC是好的。由于LOOP收集新名单，NCONC再次罚款。

这是一个实际的简单就地Quicksort向量。请注意，Quicksort实际上就是这样。使用列表的版本并不是真正的Quicksort。

(defun partition (array left right &aux (i (1- left)) 
             (j right) 
             (v (aref array right))) 
    (loop do (loop do (incf i) until (>= (aref array i) v)) 
      (loop do (decf j) until (or (zerop j) 
             (<= (aref array j) v))) 
      (rotatef (aref array i) (aref array j)) 
     until (<= j i)) 
    (rotatef (aref array j) (aref array i) (aref array right)) 
    i) 

(defun quicksort (array &optional (left 0) (right (1- (length array)))) 
    (if (> right left) 
    (let ((i (partition array left right))) 
     (quicksort array left (1- i)) 
     (quicksort array (1+ i) right)) 
    array)) 

该版本基于Sedgewick的代码。