Lisp kodunda artıklık nasıl kaldırılır?

Question

Ben Common Lisp hızlı tür bir uygulama ile gelip çalıştık ve bu ana kadar ne var ise:

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

Anlaşılan o çalışıyor, ama çok fazla tekrarı ki olduğunu düşünüyorum kodu. > vs < vs = tarafından

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

üç aramalar farklılık tek yolu: Temel olarak üç kez var.

Bu nedenle sorum şu: Bu fazlalığı nasıl kaldırabilirim ve kodu daha okunabilir ve daha kompakt hale getirebilirim?

Tabi ki gibi bir işleve şeyler, ayıklamak olabilir:

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

Ama nedense bu en iyi yaklaşım olup olmadığını gerçekten ikna olmadım. Yine pivot ve list'u tekrar tekrar ele geçirmek zorunda kalıyor.

Ben de fikri fonksiyonunun gerçek vücut daha okunabilir hale getirir flet, kullanmak, ama sadece başka bir yere karmaşıklığı taşır:

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

Başka yaklaşımlar?

Answer 1

Yerel bir işlev olarak yazarsanız, kapsam içinde olduklarından ek argümanları iletmeniz gerekmez.

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

Biraz daha kompakt sürümü: Common Lisp birden çok değer desteklediği için

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

, ayrıca tek seferde bir işlev listesini bölümlemek ve değerler olarak listelerini döndürebilir:

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

Listeler yeni tahsis edildiğinde, NCONC mümkündür. REMOVE-IF-NOT tahribatsız olduğundan (DELETE-IF-NOT ile karşılaştırın), NCONC iyi. LOOP yeni listeleri topladığından, NCONC yeniden gayet iyi.

Bu, vektörler üzerinde gerçek bir yerinde yerinde bir Quicksorttur. Quicksort'un aslında bu şekilde ifade edildiğini unutmayın. Listeleri kullanan sürümler gerçekten Quicksort değildir.

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

Bu sürüm Sedgewick koduna dayanmaktadır.