;; This file defines a set of functions for creating and manipulating
;; heaps of a fixed size as discussed in lecture.

;; A heap is simply a vector.  The first slot is used
;; to record the index of the last used node.  The
;; other slots are used to hold the elements of the
;; heap.  We initialize these elements to #f in order to make
;; it easier to debug the code.
(define (make-heap size)
  (let ((h (make-vector (+ size 1) #f)))
    (vector-set! h 0 0)
    h))

(define (heap-empty? h)
  (= (vector-ref h 0) 0))

;; h is the heap represented as a vector, and 
;; my-index is the index of a node that has been
;; recently inserted.  We bubble up the node by
;; exchanging it with its parent until we reach
;; the root of the tree or else the parent is
;; more important.
(define (bubble-up! h my-index)
  (if (= my-index 1) 
      h  ;; we're at the root so we're done
      (let* ((parent-index (floor (/ my-index 2))) ;; get parent index
             (me (vector-ref h my-index))          ;; get my value
             (parent (vector-ref h parent-index))) ;; get parent value
        (if (<= me parent)  ;; swap and continue bubbling if I'm more important
            (begin
              (swap! h my-index parent-index)
              (bubble-up! h parent-index))
            h))))

;; insert object x into the heap h by incrementing
;; the last used slot and placing x at that position
;; in h, then bubble x up.
(define (insert h x)
  (let* ((i (vector-ref h 0))
         (new-index (+ 1 i)))
    (if (>= new-index (vector-length h))  ; check for space in the heap
        (error "heap exhausted!")
        (begin 
          (vector-set! h 0 new-index) ; place me at last+1
          (vector-set! h new-index x) ; increment last
          (bubble-up! h new-index))))) ; bubble me up

;; swap to elements in a vector
(define (swap! h i j)
  (let ((x (vector-ref h i))
        (y (vector-ref h j)))
    (vector-set! h i y)
    (vector-set! h j x)))

;; Given a heap h and index of my node, bubble me down until
;; either I have no children or my children are less important.
;; If a child is more important, swap with the most important
;; child and continue bubbling down.
(define (bubble-down! h my-index)
  (let* ((child-index-one (* 2 my-index))
         (child-index-two (+ 1 child-index-one))
         (last (vector-ref h 0))
         (me (vector-ref h my-index)))
    (cond ((> child-index-one last) #f)  ; no children -- we're done
          ((> child-index-two last) ; see if we need to swap with child-one
           (let ((child-one (vector-ref h child-index-one)))
             (if (<= child-one me)
                 (swap! h my-index child-index-one)) ; no need to recurse
                 #f))
          (else 
           (let* ((child-one (vector-ref h child-index-one))
                  (child-two (vector-ref h child-index-two))
                  (min-index (if (<= child-one child-two) ; figure out which
                                 child-index-one          ; child is the most
                                 child-index-two))        ; important
                  (min-child (vector-ref h min-index)))
             (if (<= min-child me)  ; see if we must swap with most important child
                 (begin (swap! h my-index min-index)  ; if so, swap and continue
                        (bubble-down! h min-index))   ; bubbling down
                 #f)))))) ; otherwise, we're done.

;; Get the first element in the heap which we ultimately return
;; as the value.  We then swap the last element inserted into
;; the first position and bubble it down until it's more important
;; than its children (or is at a leaf.)
(define (extract-min! h)
  (let ((last (vector-ref h 0)))
    (if (= last 0)
        (error "heap is empty!")
        (let ((x (vector-ref h 1)))
          (vector-set! h 1 (vector-ref h last))
          (vector-set! h 0 (- last 1))
          (vector-set! h last #f)
          (bubble-down! h 1)
          x))))

;; A sorting routine that uses heaps to achieve an O(n * log n)
;; time for sorting.
(define (heap-sort lis)
  (let* ((len (length lis))
         (h (make-heap len)))
    ;; removes each element from a heap and accumulates them
    ;; into a list.
    (define (remove-list)
      (if (heap-empty? h)
          empty
          (cons (extract-min! h) (remove-list))))
    ;; insert each element from the list into the heap h
    ;; This takes time O(len * log len).  
    (for-each (lambda (x) (insert h x)) lis)
    ;; extract each element in order.  This also takes time
    ;; O(len * log len).  
    (remove-list)))