Come rimuovere la ridondanza nel codice Lisp?

Question

ho cercato di trovare un'attuazione rapida quelli in Common Lisp, e questo è quello che ho ottenuto finora:

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

A quanto pare funziona, ma penso che ci sia troppa ripetizione in quel codice. In sostanza, abbiamo tre volte:

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

L'unico modo in cui le tre chiamate differiscono è di gran > vs = vs <.

Quindi la mia domanda è: come posso rimuovere quella ridondanza e rendere il codice più leggibile e più compatto?

Naturalmente potrei estrarre le cose a una funzione, come ad esempio:

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

Ma in qualche modo io non sono davvero convinto se questo è l'approccio migliore. È ancora maldestro dover restituire pivot e list ancora e ancora.

Ho anche avuto l'idea di utilizzare flet, il che rende il corpo reale della funzione più leggibile, ma si muove solo la complessità da qualche altra parte:

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

Eventuali altri approcci?

Answer 1

Se lo si scrive come una funzione locale, non è necessario passare gli argomenti extra, poiché sono nell'ambito.

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

Una versione leggermente più compatta:

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

Dal Common Lisp supporta valori multipli, è anche possibile partizionare la lista in una funzione in un colpo solo e restituire le liste come valori:

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

Quando gli elenchi sono appena assegnati, è possibile NCONC. Poiché REMOVE-IF-NOT non è distruttivo (confrontare con DELETE-IF-NOT), NCONC va bene. Poiché LOOP raccoglie nuove liste, NCONC va bene.

Questo è un semplice Quicksort sul vettosto. Nota che Quicksort è in realtà inteso in quel modo. Le versioni che utilizzano le liste non sono realmente 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)) 

Questa versione è basata sul codice di Sedgewick.