Как удалить избыточность в коде 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) 

Единственный способ три вызова отличается является > против = против <.

Поэтому мой вопрос: как я мог удалить эту избыточность и сделать код более удобочитаемым и более компактным?

Конечно, я мог бы извлечь вещи функции, такие как:

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