如何刪除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的代碼。