Gaucheでヒープ

練習に「常に子よりも親が大きい（小さい）値の二分木をヒープという」を Gauche で書いてみた。

(use gauche.collection)
(use gauche.uvector)
(use srfi-43)  ;;vector-swap!

;; 親の位置
(define (parent n)  (quotient (- n 1) 2))

(define (vct-swap v x y)
  (begin (vector-swap! v x y) v))

(define (vect-if-swap vct x y)
  (if (>= (vector-length vct) 2)
    (if (< (vector-ref vct x)(vector-ref vct y))
      vct
      (vct-swap vct x y))
    vct))

;; 親より値が大きければ値を交換。
(define (change vect pos)
  (if (> pos 0)
    (let* ((new-vect (vect-if-swap vect pos (parent pos))))
        (change new-vect (parent pos)))
    vect))

;; ヒープに値を追加。
(define (push-heap elem vect)
    (change (vector-append vect (vector elem))
            (- (vector-length vect) 1)))

;; 二分木をS式で表示
(define (show_tree vect length n)
  (string-append "(" (number->string (vector-ref vect n)) " "
    (show_leaf vect length (+ (* n 2) 1) ) " "
    (show_leaf vect length (* 2  (+ n 1))) ")" ))

(define (show_leaf vect length pos)
  (if (<= pos length)
    (show_tree vect length pos) 
    "-"))

(define vect '#())
(define v-dat '#(10 1 2 66 3 4 102 33 78 9 52))

(print
  (show_tree 
    (fold push-heap vect v-dat) 
    (- (vector-length v-dat) 1)
     0))

;;=> (102 (78 (33 (1 - -) (10 - -)) (9 (3 - -) (52 - -))) (66 (2 - -) (4 - -)))