• 空キュー生成: (make-heap 比較関数)
• enqueue: (heap-add! pq value)
• リスト挿入: (heap-add-all! pq リスト)
• dequeue: (heap-remove-min! pq)
• 先頭参照: (heap-min pq)
• 配列変換: (heap->vector pq)
• キュー長: (heap-count pq)
• ヒープソート: (heap-sort! 配列 比較関数)

> (require data/heap)
> (define pq (make-heap <=))
> (heap-add-all! pq '(21 1 7 3 9 1 11 21 15 31))
> (heap-count pq)
10
> (heap->vector pq)
'#(1 1 3 7 9 11 15 21 21 31)
> (heap-min pq)
1
> (heap->vector pq)
'#(1 1 3 7 9 11 15 21 21 31)
> (heap-remove-min! pq)
> (heap->vector pq)
'#(1 3 7 9 11 15 21 21 31)

C++

OCaml

Racket

OCaml

module PriorityQueue = struct
  type 'a t = {
    mutable heap: 'a array;
    mutable size: int;
    cmp: 'a -> 'a -> int;
  }
  let create cmp init_size init_value = {
    heap = Array.make init_size init_value;
    size = 0;
    cmp
  }
  let parent i = (i - 1) / 2
  let left i = 2 * i + 1
  let right i = 2 * i + 2
  let swap heap i j =
    let temp = heap.(i) in
    heap.(i) <- heap.(j);
    heap.(j) <- temp
  let insert pq x =
    if pq.size = Array.length pq.heap then
      pq.heap <- Array.append pq.heap (Array.make pq.size pq.heap.(0));
    pq.heap.(pq.size) <- x;
    let rec heapify_up i =
      let p = parent i in
      if i > 0 && pq.cmp pq.heap.(i) pq.heap.(p) < 0 then begin
        swap pq.heap i p;
        heapify_up p
      end
    in
    heapify_up pq.size;
    pq.size <- pq.size + 1
  let extract_top pq =
    if pq.size = 0 then failwith "PriorityQueue is empty";
    let top = pq.heap.(0) in
    pq.size <- pq.size - 1;
    pq.heap.(0) <- pq.heap.(pq.size);
    let rec heapify_down i =
      let l = left i and r = right i in
      let smallest = ref i in
      if l < pq.size && pq.cmp pq.heap.(l) pq.heap.(!smallest) < 0 then
        smallest := l;
      if r < pq.size && pq.cmp pq.heap.(r) pq.heap.(!smallest) < 0 then
        smallest := r;
      if !smallest <> i then begin
        swap pq.heap i !smallest;
        heapify_down !smallest
      end
    in
    heapify_down 0;
    top
  let rec heap_to_list pq acc =
    if pq.size = 0 then
      List.rev acc
    else
      let top = extract_top pq in
      heap_to_list pq (top :: acc)
end

C++

#include <chrono>
#include <fstream>
#include <iostream>
#include <print>
#include <queue>
#include <sstream>
#include <stdexcept>
#include <vector>
 
bool test(const std::string &infile, const std::string &outfile) {
  std::vector<long> arr;
  // read file
  auto start = std::chrono::high_resolution_clock::now();
  std::ifstream fin(infile);
  if (!fin) {
    throw std::runtime_error("Could not open file for reading.");
    return false;
  }
  int num;
  while (fin >> num)
    arr.push_back(num);
  fin.close();
  auto end = std::chrono::high_resolution_clock::now();
  std::chrono::duration<double> duration = end - start;
  std::println("length = {}", arr.size());
  std::println("read time:  {:9.6f} [sec]", duration.count());
  // make pqueue
  start = std::chrono::high_resolution_clock::now();
  std::priority_queue<long, std::vector<long>, std::greater<long>> pque;
  for (long i : arr)
    pque.push(i);
  end = std::chrono::high_resolution_clock::now();
  duration = end - start;
  std::println("priority queue size = {}", pque.size());
  std::println("make pque:  {:9.6f} [sec]", duration.count());
  // to vector
  start = std::chrono::high_resolution_clock::now();
  std::vector<long> arr2;
  while (!pque.empty()) {
    arr2.push_back(pque.top());
    pque.pop();
  }
  end = std::chrono::high_resolution_clock::now();
  duration = end - start;
  std::println("length = {}", arr2.size());
  std::println("to vector:  {:9.6f} [sec]", duration.count());
  // write file
  start = std::chrono::high_resolution_clock::now();
  std::ofstream fout(outfile);
  if (!fout) {
    throw std::runtime_error("Could not open file for writing.");
    return false;
  }
  std::ostringstream buf;
  for (long num : arr2)
    buf << num << "\n";
  fout << buf.str();
  fout.close();
  end = std::chrono::high_resolution_clock::now();
  duration = end - start;
  std::println("write time: {:9.6f} [sec]", duration.count());
  return true;
}
 
int main(int argc, char *argv[]) {
  try {
    if (argc != 3) {
      throw std::invalid_argument(
          "Usage: main <infile> <outfile>");
    }
    std::string infile(argv[1]);
    std::string outfile(argv[2]);
    if (!test(infile, outfile))
      std::println("An error has occurred.");
  } catch (const std::logic_error &e) {
    std::println(stderr, "Logic error: {}", e.what());
  } catch (const std::runtime_error &e) {
    std::println(stderr, "Runtime error: {}", e.what());
  } catch (const std::exception &e) {
    std::println(stderr, "Another std::exception: {}", e.what());
  } catch (...) {
    std::println(stderr, "Unknown exception.");
  }
  return 0;
}

CPPG = g++
CPPL = clang++
CPPFLAGS = -std=c++23 -O2
SRC = main.cpp
EXES = main_g main_l
 
all: $(EXES)
 
main_g: $(SRC)
	$(CPPG) $(CPPFLAGS) -o $@ $(SRC)
 
main_l: $(SRC)
	$(CPPL) $(CPPFLAGS) -o $@ $(SRC)
 
clean:
	rm -f $(EXES)

$ measure ./main_g uniform1m.txt sorted_g.txt
length = 1000000
read time:   0.094745 [sec]
priority queue size = 1000000
make pque:   0.026717 [sec]
length = 1000000
to vector:   0.221406 [sec]
write time:  0.092484 [sec]
======================================
Process exited with status: 0
total time:  0.438419 [sec]
mem  size:      45516 [KB]
code size:        138 [KB]

$ measure ./main_l uniform1m.txt sorted_l.txt
length = 1000000
read time:   0.095377 [sec]
priority queue size = 1000000
make pque:   0.028486 [sec]
length = 1000000
to vector:   0.194962 [sec]
write time:  0.090033 [sec]
======================================
Process exited with status: 0
total time:  0.411832 [sec]
mem  size:      46392 [KB]
code size:        107 [KB]

OCaml

open Printf
module PQ = Pqueue.PriorityQueue
 
let read_data filename =
  let ichan = open_in filename in
  let rec read_lines acc =
    match input_line ichan with
    | line ->
      let num = int_of_string line in
      read_lines (num :: acc)
    | exception End_of_file ->
      close_in ichan;
      List.rev acc in
  read_lines []
 
let write_data filename lst =
  let ochan = open_out filename in
  List.iter (fun x -> fprintf ochan "%d\n" x) lst;
  close_out ochan
 
let test infile outfile =
  (* read file *)
  let start = Unix.gettimeofday () in
  let lst = read_data infile in
  let end_ = Unix.gettimeofday () in
  let len = (List.length lst) in
  printf "length = %d\n" len;
  printf "read time:  %9.6f [sec]\n" (end_ -. start);
  (* make pqueue *)
  let start = Unix.gettimeofday () in
  let pque = PQ.create compare len 0 in
  List.iter (fun x -> PQ.insert pque x) lst;
  let end_ = Unix.gettimeofday () in
  printf "priority queue size = %d\n" (pque.size);
  printf "make pque:  %9.6f [sec]\n" (end_ -. start);
  (* to list *)
  let start = Unix.gettimeofday () in
  let lst2 = PQ.heap_to_list pque [] in
  let end_ = Unix.gettimeofday () in
  printf "length = %d\n" (List.length lst2);
  printf "to list:    %9.6f [sec]\n" (end_ -. start);
  (* write file *)
  let start = Unix.gettimeofday () in
  write_data outfile lst2;
  let end_ = Unix.gettimeofday () in
  printf "write time: %9.6f [sec]\n" (end_ -. start)
 
let () =
  try
    if Array.length Sys.argv <> 3 then
      raise (Invalid_argument
        "Usage: main <infile> <outfile>")
    else
      let infile =  Sys.argv.(1) in
      let outfile =  Sys.argv.(2) in
      test infile outfile
  with
    | Invalid_argument msg ->
        eprintf "Logic error: %s\n" msg
    | Failure msg ->
        eprintf "Runtime error: %s\n" msg
    | exn ->
        eprintf "Another exception: %s\n" (Printexc.to_string exn)

OCAMLOPT = ocamlopt
OCAMLFLAGS = -O2
LIBPATH = -I +unix
LIBS = unix.cmxa 
SRCS = pqueue.ml main.ml
EXES = main
 
all: $(EXES)
 
main: $(SRCS)
	$(OCAMLOPT) $(OCAMLFLAGS) $(LIBPATH) -o $@ $(LIBS) $(SRCS)
 
clean:
	rm -f $(EXES) *.o *.cmx *.cmi

$ measure ./main uniform1m.txt sorted.txt
length = 1000000
read time:   0.298860 [sec]
priority queue size = 1000000
make pque:   0.096129 [sec]
length = 1000000
to list:     0.827671 [sec]
write time:  0.226117 [sec]
======================================
Process exited with status: 0
total time:  1.463985 [sec]
mem  size:      72612 [KB]
code size:       3301 [KB]

Racket

#lang racket
(require iso-printf)
(require data/heap)
 
(define (read-data filename)
  (call-with-input-file filename
    (lambda (port)
      (let loop ([lst '()])
        (let ([line (read-line port)])
          (if (eof-object? line)
              (reverse lst)
              (loop (cons (string->number line) lst))))))))
 
(define (write-data filename lst)
  (call-with-output-file filename #:exists 'replace
    (lambda (port)
      (for-each (lambda (num) (displayln num port))
                lst))))
 
(define (test infile outfile)
  ; read file
  (define start (current-inexact-milliseconds))
  (define lst (read-data infile))
  (define end (current-inexact-milliseconds))
  (printf "length = %d\n" (length lst))
  (printf "read time:  %9.6f [sec]\n" (/ (- end start) 1000.0))
  ; make pqueue
  (set! start (current-inexact-milliseconds))
  (define pque (make-heap <=))
  (heap-add-all! pque lst)
  (set! end (current-inexact-milliseconds))
  (printf "priority queue size = %d\n" (heap-count pque))
  (printf "make pque:  %9.6f [sec]\n" (/ (- end start) 1000.0))
  ; to list
  (set! start (current-inexact-milliseconds))
  (define lst2 (vector->list (heap->vector pque)))
  (set! end (current-inexact-milliseconds))
  (printf "length = %d\n" (length lst2))
  (printf "to list:    %9.6f [sec]\n" (/ (- end start) 1000.0))
   ; write file
  (set! start (current-inexact-milliseconds))
  (write-data outfile lst2)
  (set! end (current-inexact-milliseconds))
  (printf "write time: %9.6f [sec]\n" (/ (- end start) 1000.0)))
 
(define (main args)
  (with-handlers
    ([exn:fail? (λ (e) (eprintf "%s\n" (exn-message e)))]
     [exn? (λ (e) (eprintf "Unexpected: %s\n" (exn-message e)))])
  (cond
    [(not (= (vector-length args) 2))
      (error "Usage: main <infile> <outfile>")]
    [else
      (let ([infile (vector-ref args 0)]
            [outfile (vector-ref args 1)])
        (test infile outfile))])))
 
(main (current-command-line-arguments))

$ raco exe pqueue.rkt
$ measure ./pqueue uniform1m.txt sorted.txt
length = 1000000
read time:   0.802043 [sec]
priority queue size = 1000000
make pque:   0.118830 [sec]
length = 1000000
to list:     0.585107 [sec]
write time:  0.738563 [sec]
======================================
Process exited with status: 0
total time:  2.730633 [sec]
mem  size:     171040 [KB]
code size:      12514 [KB]