#|
Sorting in LISP.
You will probably never need to write a sorting function in lisp
because the built in function (sort) is so good. However, sorting is
a common problem in computer science and it is an interesting test of
a language to see how easy it is to implement different sorting
algorithms.
Like most functional languages, implementing functional sorts is easy
in lisp while implementing procedural sorts is difficuilt. This means
that algorithmic sorts such as quicksort will be simple while sorts
which modify the array like bubble sort will be worst.
Quicksort is by far the simplest, requiring only five lines of code.
Selection sort also did surprisingly well, especially if min-list is
replaced by apply #'min. Insertion sort is surprisingly complex,
mostly because inserting an item into a sorted list is difficuilt.
Bucket sort is very simple but not very resource efficient (as per
usual). Bubble sort is quite small but very hard to read. Heap sort
is the big winner. Heap sort is generally taught as 'you can also
sort using a heap but it is too complex to do in practise'. This
shows that in a functional language, heap-sort isn't too complex
(especially if you already have tree manipulation routines.
|#
(defun quick-sort (l)
"Quicksort divides all elements into smaller or larger than the first element.
These are then sorted recursivly with the first element in the middle"
(if (null l) nil ; Recursive case
(labels ((bigger-el (x) (> x (first l)))) ; t if x > first
(let ((smaller (remove-if #'bigger-el (rest l))) ; all < first
(bigger (remove-if-not #'bigger-el (rest l)))) ; all > first
(append (quicksort smaller) (list (first l)) (quicksort bigger))))))
(defun selection-sort (l)
"Finds the smallest element in l and adds it to the result This function must
continually remove items from l which makes it very slow"
(labels ((min-list (l)
(let ((best (first l)))
(dolist (el l best)
(if (< el best) (setf best el))))))
(do* ((so-far nil (push (min-list lis) so-far))
(lis l (remove (min-list lis) lis)))
((null lis) (reverse so-far)))))
(defun insertion-sort (l)
"Inserts every element of l into a sorted sublist. InsertOrd inserts the
element in order using recursion, so-far maintains the sorted sublist"
(labels ((insertOrd (theNumber lesser theRest)
(if (null theRest)
(append lesser (list theNumber))
(let ((lo (first theRest)))
(if (< lo theNumber)
(insertOrd theNumber
(append lesser (list lo))
(rest theRest))
(append lesser (list theNumber) theRest))))))
(let ((so-far nil))
(dolist (el l so-far)
(setf so-far (insertord el nil so-far))
(1+ (aref table item))))
(mm (x) (- x min))) ; Returns x minus min (for aref
(mapcar #'insert (mapcar #'mm l))
(dotimes (x (1+ (- max min)) (reverse result-list))
(dotimes (count (aref table x))
(push (+ min x) result-list))))
(defun bubble-sort (l)
(let ((array-version (make-array (length l)))
(list-len (length l))
temp)
(dotimes (pos list-len)
(setf (aref array-version pos) (nth pos l)))
(dotimes (x list-len)
(do ((y 0 (1+ y)))
((= (1+ y) list-len) t)
(when (> (aref array-version y) (aref array-version (1+ y)))
(setf temp (aref array-version y)
(aref array-version y) (aref array-version (1+ y))
(aref array-version (1+ y)) temp))))
(dotimes (pos list-len)
(setf (nth pos l) (aref array-version pos)))
l))
(defun heap-sort (l)
"Inserts every element into a sorted binary tree.
The tree is then scanned 'inorder'"
(labels ((tree-insert (el tree)
(cond ((null tree)
(list nil el nil))
((< el (second tree))
(list (tree-insert el (first tree))
(second tree)
(third tree)))
((>= el (third tree))
(list (first tree)
(second tree)
(tree-insert el (third tree))))))
(tree-leaves (tree)
(if (null tree) nil
(remove nil (append (tree-leaves (first tree))
(list (second tree))
(tree-leaves (third tree)))))))
(let ((tree-so-far nil))
(dolist (el l (tree-leaves tree-so-far))
(setf tree-so-far (tree-insert el tree-so-far))))))