Yoy-wiw

 1 ;;;;
 2 (defun exchange (array i j)
 3   (let ((tmp (aref array i)))
 4     (setf (aref array i) (aref array j))
 5     (setf (aref array j) tmp))
 6   array)
 7 ;;Recursively exchange value between parent and children when either child is bigger.
 8 (defun heapsort-maxup (array i heap-size)
 9   (let* ((left (1+ (* 2 i)))
10          (right (* 2 (1+ i)))
11          (bigger (if (< right heap-size)
12                      (if (< (aref array left) (aref array right)) right left)
13                      (if (< left heap-size) left i))))
14     (when (< (aref array i) (aref array bigger))
15       (heapsort-maxup (exchange array i bigger) bigger heap-size))
16     array))
17 ;;Make the array heap structrue.
18 (defun heapsort-build (array heap-size)
19   (let ((half (floor (/ heap-size 2))))
20     (loop until (< half 1)
21        do (setf array (heapsort-maxup array (decf half) heap-size)))
22     array))
23 ;;Heapsort funtion.
24 (defun heapsort (array)
25   (loop for heap-size from (length array) downto 1
26      do (setf array (exchange (heapsort-build array heap-size) 0 (1- heap-size))))
27   array)
28 ;;For testing.
29 (defun heapsort-test (count)
30   (let ((array (make-array count :element-type 'integer)))
31     (dotimes (i count)
32       (setf (aref array i) (random (* count 10))))
33     (format t "~A~%" array)
34     (format t "~A~%" (heapsort array))))
35