How to remove redundancy in Lisp code?

Question

I have tried to come up with an implementation of quick sort in Common Lisp, and this is what I have got so far:

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

Apparently it works, but I think that there is too much repetition in that code. Basically, we have three times:

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

The only way the three calls differ is by > vs = vs <.

Hence my question is: How could I remove that redundancy and make the code more readable and more compact?

Of course I could extract things to a function, such as:

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

But somehow I'm not really convinced whether this is the best approach. It still feels clumsy to have to hand over pivot and list again and again.

I also had the idea to use flet, which makes the actual body of the function more readable, but only moves the complexity to somewhere else:

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

Any other approaches?

Answer 1

If you write it as a local function, you don't have to pass the extra arguments, since they are in scope.

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

A slightly more compact version:

(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 #'>))))))

Since Common Lisp supports multiple values, you can also partition the list in one function in one go and return the lists as values:

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

When lists are freshly allocated, then NCONC is possible. Since REMOVE-IF-NOT is non-destructive (compare with DELETE-IF-NOT), NCONC is fine. Since LOOP collects new lists, NCONC is fine again.

This is an actual simple in-place Quicksort over vectors. Note that Quicksort is actually meant that way. Versions using lists are not really 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))

This version is based on code from Sedgewick.