Heap sort - Rhea

;Stephen Rudolph
;2/20/09
;Heap-Sort
 
(defun parent(i)
    (max (/ (- i (mod i 2)) 2) 1))
 
(defun right(i)
    (+ (* 2 i) 1))
 
(defun left(i)
    (* 2 i))
 
(defun set-at-n(A n x)
    (if (= n 1)
        (cons x (cdr A))
        (cons (car A) (set-at-n (cdr A) (- n 1) x))))
 
;;Reverse cdr, return a list containing everything but the last element
(defun rcdr(A)
    (if (= (length A) 1)
        NIL
        (append (list (car A)) (rcdr (cdr A)))))
 
;;Reverse car, return the last element
(defun rcar(A)
    (if (= (length A) 1)
        (car A)
        (rcar (cdr A))))
 
(defun exchange-with-values(A i j x y)
    (set-at-n (set-at-n A i y) j x))
 
(defun exchange(A i j)
    (exchange-with-values A i j (nth (- i 1) A) (nth (- j 1) A)))
 
(defun heapify(A i size)
    (if (and (<= (left i) size) (> (nth (- (left i) 1)  A) (nth (- i 1) A)))
        (if (and (<= (right i) size) (> (nth (- (right i) 1) A) (nth (- (left i) 1) A)))
            (heapify (exchange A i (right i)) (right i) size)
            (heapify (exchange A i (left i)) (left i) size))
        (if (and (<= (right i) size) (> (nth (- (right i) 1) A) (nth (- i 1) A)))
            (heapify (exchange A i (right i)) (right i) size)
            A)))
 
(defun build-heap-loop(A i)
    (if (= i 0)
        A
        (build-heap-loop (heapify A i (length A)) (- i 1))))
 
(defun build-heap(A)
    (build-heap-loop A (floor (/ (length A) 2))))
 
(defun heap-sort-loop(A i)
    (if (= i 1)
        A
        (append (heap-sort-loop (heapify (rcdr (exchange A 1 i)) 1 (- (length A) 1)) (- i 1)) (list (car A)))))
 
(defun heap-sort(A)
    (heap-sort-loop (build-heap A) (length A)))