動機

priority queue は Dijkstra 法などに用いられ、コレクション内の最小・最大の要素を高速に取り出すことができる便利なデータ構造です。しかしながら Fortran には実装されていないので、自分で実装します。今回は integer を要素として持ち、コレクション内の最小値を取り出せるものを作成します。

priority queue とは

priority queue は追加する要素に優先度をつけ、取り出す際には優先度の高いものから取り出すことのできるデータ構造です。実装にはヒープ構造を用いるものが多いようです。 priority queue に要素を追加するのは $O(\mathrm{log}N)$ 、priority queue から要素を取り出すのは $O(\mathrm{log}N)$ の時間で行うことができます。

環境

macOS Sierra (10.12.6)
GNU Fortran (GCC) 6.3.0

プログラム

実際に実装したのが以下のものです。

priority_queue.f08

module mod_priority_queue
  implicit none

  type t_priority_queue
    integer :: num = 0
    integer, pointer :: heap(:) => null()
  end type t_priority_queue

contains

  subroutine offer(pq,item)
    implicit none
    type(t_priority_queue), intent(inout) :: pq
    integer, intent(in) :: item
    integer :: n, i, t
    integer, allocatable :: tmp(:)

    if (.not.associated(pq%heap)) allocate(pq%heap(1))
    if (pq%num == size(pq%heap)) then
      allocate(tmp(pq%num))
      tmp = pq%heap
      deallocate(pq%heap)
      allocate(pq%heap(2*pq%num))
      pq%heap(1:pq%num) = tmp
      deallocate(tmp)
    end if

    pq%num = pq%num+1
    pq%heap(pq%num) = item

    n = pq%num
    do while (n > 1)
      i = n/2
      if (pq%heap(n) < pq%heap(i)) then
        t = pq%heap(n)
        pq%heap(n) = pq%heap(i)
        pq%heap(i) = t
      end if
      n = i
    end do
    return
  end subroutine offer

  subroutine clear(pq)
    implicit none
    type(t_priority_queue), intent(inout) :: pq

    if (associated(pq%heap)) deallocate(pq%heap)
    pq%num = 0
    return
  end subroutine clear

  function poll(pq) result(item)
    implicit none
    type(t_priority_queue), intent(inout) :: pq
    integer :: item, n, i, j, tmp

    n = pq%num
    item = pq%heap(1)
    pq%heap(1) = pq%heap(n)
    pq%num = pq%num-1

    i = 1
    do while (2*i < n)
      j = 2*i
      if (j+1 < n .and. pq%heap(j+1) < pq%heap(j)) j = j+1
      if (pq%heap(j) < pq%heap(i)) then
        tmp = pq%heap(j)
        pq%heap(j) = pq%heap(i)
        pq%heap(i) = tmp
      end if
      i = j
    end do
    return
  end function poll

  function peek(pq) result(item)
    implicit none
    type(t_priority_queue), intent(inout) :: pq
    integer :: item

    item = pq%heap(1)
    return
  end function peek

end module mod_priority_queue

また、実装できているか確認するために以下のプログラムも書きました。

test_priority_queue.f08

program test_priority_queue
  use mod_priority_queue
  implicit none
  integer, parameter :: n = 6
  type(t_priority_queue) :: pq
  integer :: x(n), i

  call random_seed_clock()
  call randint(x,10*n)

  do i = 1, n
    call offer(pq,x(i))
    write(*,'("offer: ",i0," size: ",i0)') x(i), pq%num
  end do

  do while (pq%num > 0)
    write(*,'("poll: ",i0," size: ",i0)') poll(pq), pq%num
  end do

  call randint(x,10*n)

  do i = 1, n
    call offer(pq,x(i))
    write(*,'("offer: ",i0," size: ",i0)') x(i), pq%num
  end do

  write(*,'("peek: ",i0," size: ",i0)') peek(pq), pq%num

  call clear(pq)
  write(*,'("clear, size: ",i0)') pq%num

  call randint(x,10*n)

  do i = 1, n
    call offer(pq,x(i))
    write(*,'("offer: ",i0," size: ",i0)') x(i), pq%num
  end do

  write(*,'("peek: ",i0," size: ",i0)') peek(pq), pq%num

  stop
contains

  subroutine random_seed_clock()
    implicit none
    integer :: nseed, clock
    integer, allocatable :: seed(:)

    call system_clock(clock)
    call random_seed(size=nseed)
    allocate(seed(nseed))
    seed = clock
    call random_seed(put=seed)
    deallocate(seed)
    return
  end subroutine random_seed_clock

  subroutine randint(x,maxint)
    implicit none
    integer, intent(out) :: x(:)
    integer, intent(in) :: maxint
    real(8) :: r(size(x))

    call random_number(r)
    x = int(maxint*r)
    return
  end subroutine randint

end program test_priority_queue

実行結果は以下のとおりです。

offer: 22 size: 1
offer: 19 size: 2
offer: 37 size: 3
offer: 40 size: 4
offer: 56 size: 5
offer: 50 size: 6
poll: 19 size: 5
poll: 22 size: 4
poll: 37 size: 3
poll: 40 size: 2
poll: 50 size: 1
poll: 56 size: 0
offer: 43 size: 1
offer: 57 size: 2
offer: 41 size: 3
offer: 23 size: 4
offer: 2 size: 5
offer: 50 size: 6
peek: 2 size: 6
clear, size: 0
offer: 8 size: 1
offer: 43 size: 2
offer: 6 size: 3
offer: 8 size: 4
offer: 29 size: 5
offer: 38 size: 6
peek: 6 size: 6

これで逐次的に最小値を取り出せるデータ構造が手に入りました。

追記 2019/08/11

不必要な部分を削り、よりオブジェクト指向な書き方に変更しました (ソースコード) 。