14 章「ヒープ」 - 珠玉のプログラミング(Programming Pearls)

珠玉のプログラミングの14章。

14.6.1

分からなかったので答えを見た。実装のチューニングをしろという問題意図らしい。

14.6.2, 14.6.3

略。

14.6.4

ハフマン符号

頻度が少ない順に取り出す

浮動小数

小さい順に足しあわせる

ファイル

サイズ順に突っ込む。

マージ

ルート同士を比較して小さい方を場に出してマージしていく。

14.6.5

略。

14.6.6

ブロック番号順にヒープに入れればよい。

14.6.7

答え見た。なるほど。

14.6.8

k を index にした配列。重複が許されないか。

14.6.9

分からない。

14.6.10

確率は 1/2 。1位と同じ組になるかどうかの違い。

14.6.11

STL に heap がある。調べるまで知らなかった。

コード

;; Programming Pearls Chapter 14
(import (rnrs)
        (mosh)
        (mosh control)
        (match)
        (srfi :27)
        (srfi :8)
        (only (srfi :1) list-tabulate)
        (mosh test))

(define-record-type heap
  (fields
   (immutable vec)
   (immutable max-size)
   (mutable size))
  (protocol
   (lambda (c)
     (lambda (max-size)
       (c (make-vector max-size) max-size 0)))))

(define (parent-index index)
  (div index 2))


(define (heap-get heap index)
  (vector-ref (heap-vec heap) (- index 1)))

(define (heap-set! heap index value)
  (vector-set! (heap-vec heap) (- index 1) value))

(define (swap! heap i j)
  (let ([temp (heap-get heap i)])
    (heap-set! heap i (heap-get heap j))
    (heap-set! heap j temp)))

(define (shift-up! heap n)
  (cond
   [(= n 1)]
   [(< (heap-get heap n) (heap-get heap (parent-index n)))
    (swap! heap n (parent-index n))
    (shift-up! heap (parent-index n))]
   [else '()]))

(define (shift-down! heap n)
  (let1 child-index (* n 2)
    (cond
     [(> child-index (heap-size heap))]
     [else
      (let1 child-index (if (and (>= (heap-size heap) (+ child-index 1)) (> (heap-get heap (+ child-index 1)) (heap-get heap child-index)))
                            (+ child-index 1)
                            child-index)
        (cond
         [(> (heap-get heap n) (heap-get heap child-index))
          (swap! heap n child-index)
          (shift-down! heap child-index)]
         [else '()]))])))

(define (heap-pop! heap)
  (cond
   [(= (heap-size heap) 0)
    (error 'heap-pop! "min-size")]
   [else
    (let1 t (heap-get heap 1)
      (heap-set! heap 1 (heap-get heap (heap-size heap)))
      (heap-set! heap (heap-size heap) 'undef)
      (heap-size-set! heap (- (heap-size heap) 1))
      (shift-down! heap 1)
      t)]))

(define (heap-insert! heap value)
  (cond
   [(= (heap-size heap) (heap-max-size heap))
    (error 'heap-insert "max-size")]
   [else
    (heap-size-set! heap (+ 1 (heap-size heap)))
    (heap-set! heap  (heap-size heap) value)
    (shift-up! heap (heap-size heap))]))

(define (heap-valid? obj)
  #t)


(test-true (heap? (make-heap 3)))

(let ([heap (make-heap 3)])
  (test-equal 0 (heap-size heap))
  (heap-insert! heap 5)
  (test-equal 1 (heap-size heap))
  (heap-insert! heap 4)
  (test-equal 2 (heap-size heap))
  (heap-insert! heap 3)
  (test-equal 3 (heap-size heap))
  (test-equal 3 (heap-pop! heap))
  (test-equal 2 (heap-size heap))
  (test-equal 4 (heap-pop! heap))
  (test-equal 1 (heap-size heap))
  (test-equal 5 (heap-pop! heap))
  (test-equal 0 (heap-size heap))
  (test-true (heap-valid? heap)))

(test-results)

珠玉のプログラミング—本質を見抜いたアルゴリズムとデータ構造
ジョン ベントリー
ピアソンエデュケーション
売り上げランキング: 5607