description.md

C++

$ time ./a.out 
1000000

real	0m0.863s
user	0m0.860s
sys	0m0.000s

data.heap

$ time gosh heaptest.scm
1000000

real	1m57.394s
user	2m42.164s
sys	0m0.896s

tree-map

$ time gosh heaptest-tree.scm
1000000

real	0m0.661s
user	0m0.728s
sys	0m0.012s

C++ の優先度付きキューより速い？？

heaptest-tree.scm

(define (main . args)
  (let ((tree (make-tree-map)))

    ;;(tree-map-push! tree 10 '-)
    (tree-map-push! tree 1000000 '-)

    (print (let loop ((count 0))
             (let ((max (pop-max! tree)))
               (if (zero? max)
                   count
                   (begin
                     (if (odd? max)
                         (begin
                           (tree-map-push! tree (/ (- max 1) 2) '-)
                           (tree-map-push! tree (/ (- max 1) 2) '-))
                         (begin
                           (tree-map-push! tree (/ max 2) '-)
                           (tree-map-push! tree (- (/ max 2) 1) '-)))
                     (loop (+ count 1)))))))))

(define (pop-max! tree)
  (let* ((vals (tree-map-pop-max! tree))
         (key (car vals)))
    (when (pair? (cddr vals))
          (tree-map-put! tree key (cddr vals)))
    key))

heaptest.cpp

#include <queue>
#include <iostream>

int main()
{
    std::priority_queue<int> q;
    q.push(1000000);

    int max = q.top();
    int count = 0;
    q.pop();
    do {
        if (max & 1) {
            q.push((max - 1) / 2);
            q.push((max - 1) / 2);
        } else {
            q.push(max / 2);
            q.push(max / 2 - 1);
        }
        max = q.top();
        q.pop();
        count ++;
    } while (max != 0);

    std::cout << count << std::endl;
}

heaptest.scm

(use data.heap)

(define (main . args)
  (let ((heap (make-binary-heap)))

    ;; (binary-heap-push! heap 100)
    (binary-heap-push! heap 1000000)

    (print (let loop ((count 0))
             (let ((max (binary-heap-pop-max! heap)))
               (if (zero? max)
                   count
                   (begin
                     (if (odd? max)
                         (begin
                           (binary-heap-push! heap (/ (- max 1) 2))
                           (binary-heap-push! heap (/ (- max 1) 2)))
                         (begin
                           (binary-heap-push! heap (/ max 2))
                           (binary-heap-push! heap (- (/ max 2) 1))))
                     (loop (+ count 1)))))))))