目次
概要
ヒープソートとは、データを昇順、降順に並び替えるアルゴリズムの１つです。
計算量は $O(n\log{n})$ です。
例えば、
99, 3, 4, 7, 55, 1, 6, 2という順列を与えると、
1, 2, 3, 4, 6, 7, 55, 99や 99, 55, 7, 6, 4, 3, 2, 1が求められます。
データを並び替える機能はCやPythonでは、qsort関数sort関数によって標準で搭載されています。
Fortranには同様の機能は標準で搭載されていませんので、ヒープソートのプログラムを自分で書いて実装してみます。
ヒープソートには`安定の保証がないデメリットがあります。
今回は単純な数列の並び替えを想定しますので、解説の対象外とします。
今後ソート関係の記事を書き終えたら個別に記事を作成して解説します。
[記事ができたらここにURLを入れる。]
アルゴリズム
アルゴリズムについての詳細な説明は既に多くのWebサイトで解説されていますので、本記事では説明を省略します。
参考として、以下のWebサイトのリンクを記載します。
プログラム例
99 3 4 7 55 1 6 2を降順に並び替えてみます。
実行結果
途中過程を含めたヒープソートによる並び替えの過程を以下に示します。
【実行結果】長いので畳んでいます。
並び替え前 99 3 4 7 55 1 6 2
a b c d e f g h
ヒープの構成
target 7
step
1 | 99
2 | 3 4
3 | 7 55 1 6
4 | 2
→ 2 <= 7 ：入れ替えする
result
1 | 99
2 | 3 4
3 | 2 55 1 6
4 | 7
target 4
step
1 | 99
2 | 3 4
3 | 2 55 1 6
4 | 7
→ 1 < 6 ：1 を採用
→ 1 <= 4 ：入れ替えする
result
1 | 99
2 | 3 1
3 | 2 55 4 6
4 | 7
target 3
step
1 | 99
2 | 3 1
3 | 2 55 4 6
4 | 7
→ 2 < 55 ：2 を採用
→ 2 <= 3 ：入れ替えする
step
1 | 99
2 | 2 1
3 | 3 55 4 6
4 | 7
→ 7 > 3 ：入れ替えしない
result
1 | 99
2 | 2 1
3 | 3 55 4 6
4 | 7
target 99
step
1 | 99
2 | 2 1
3 | 3 55 4 6
4 | 7
→ 2 >= 1 ：1 を採用
→ 1 <= 99 ：入れ替えする
step
1 | 1
2 | 2 99
3 | 3 55 4 6
4 | 7
→ 4 < 6 ：4 を採用
→ 4 <= 99 ：入れ替えする
result
1 | 1
2 | 2 4
3 | 3 55 99 6
4 | 7
7 と 1 を入れ替え ： 1を最後尾に確定
target 7
step
1 | 7
2 | 2 4
3 | 3 55 99 6
4 | 1
→ 2 < 4 ：2 を採用
→ 2 <= 7 ：入れ替えする
step
1 | 2
2 | 7 4
3 | 3 55 99 6
4 | 1
→ 3 < 55 ：3 を採用
→ 3 <= 7 ：入れ替えする
1 | 2
2 | 3 4
3 | 7 55 99 6
4 | 1
6 と 2 を入れ替え ： 2を最後尾に確定
target 6
step
1 | 6
2 | 3 4
3 | 7 55 99 2
4 | 1
→ 3 < 4 ：3 を採用
→ 3 <= 6 ：入れ替えする
step
1 | 3
2 | 6 4
3 | 7 55 99 2
4 | 1
→ 7 < 55 ：7 を採用
→ 7 > 6 ：入れ替えしない
1 | 3
2 | 6 4
3 | 7 55 99 2
4 | 1
99 と 3 を入れ替え ： 3を最後尾に確定
target 99
step
1 | 99
2 | 6 4
3 | 7 55 3 2
4 | 1
→ 6 >= 4 ：4 を採用
→ 4 <= 99 ：入れ替えする
1 | 4
2 | 6 99
3 | 7 55 3 2
4 | 1
55 と 4 を入れ替え ： 4を最後尾に確定
target 55
step
1 | 55
2 | 6 99
3 | 7 4 3 2
4 | 1
→ 6 < 99 ：6 を採用
→ 6 <= 55 ：入れ替えする
step
1 | 6
2 | 55 99
3 | 7 4 3 2
4 | 1
→ 7 <= 55 ：入れ替えする
1 | 6
2 | 7 99
3 | 55 4 3 2
4 | 1
55 と 6 を入れ替え ： 6を最後尾に確定
target 55
step
1 | 55
2 | 7 99
3 | 6 4 3 2
4 | 1
→ 7 < 99 ：7 を採用
→ 7 <= 55 ：入れ替えする
1 | 7
2 | 55 99
3 | 6 4 3 2
4 | 1
99 と 7 を入れ替え ： 7を最後尾に確定
target 99
step
1 | 99
2 | 55 7
3 | 6 4 3 2
4 | 1
→ 55 <= 99 ：入れ替えする
1 | 55
2 | 99 7
3 | 6 4 3 2
4 | 1
99 と 55 を入れ替え ： 55を最後尾に確定
target 99
1 | 99
2 | 55 7
3 | 6 4 3 2
4 | 1
並び替え後 99 55 7 6 4 3 2 1
a e d g c b h f
サンプルプログラム
module global_variable
implicit none
!num：並び替えたい配列
!N ：並び替えたい配列のサイズ
integer(4) num(8)
character(1) c(8)
integer(4) N
data num/99, 3, 4, 7, 55, 1, 6, 2/
data c/'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h'/
end module
program ex_heapsort
use global_variable
implicit none
N = 8
write (*, '(a)', advance='no') '並び替え前'
write (*, '(*(2x,i2))') num
write (*, '(a)', advance='no') ' '
write (*, '(*(2x,a2))') c
call heapsort(N, num, c)
write (*, '(a)', advance='no') '並び替え後'
write (*, '(*(2x,i2))') num
write (*, '(a)', advance='no') ' '
write (*, '(*(2x,a2))') c
contains
subroutine heapsort(N, x, y)
implicit none
integer(4) N, k
integer(4) x(N), tmp_x
character(1) y(N), tmp_y
integer i, j
!ヒープの構成
write (*, '(a)') 'ヒープの構成'
do k = n/2, 1, -1
tmp_x = x(k)
tmp_y = y(k)
call makeheap(x, y, k, n, tmp_x, tmp_y)
write (*, '(4x,a)') 'result'
call output_current_heap(x, N)
end do
!ヒープソート
do k = n, 2, -1
write (*, '(i0,a,i0,a,i0,a)') x(k), ' と ', x(1), ' を入れ替え ： ', x(1), 'を最後尾に確定'
tmp_x = x(k) !*一番上は一番でかいはずなので、一番後ろに入れる。次のcallで末尾をk-1にして外すため。
x(k) = x(1) ! *x(1)がx(k)のままなのでソートできない様に見えるが、実際は親と子の比較はvalとx(j)でするのでx(1)を使うことはない。
x(1) = tmp_x
tmp_y = y(k) ! *値自体も最後にmaheapでx(i)=valで書き換えるので大丈夫。
y(k) = y(1)
y(1) = tmp_y
call makeheap(x, y, 1, k - 1, tmp_x, tmp_y)
call output_current_heap(x, N)
end do
return
end subroutine heapsort
subroutine makeheap(x, y, root, leaf, val_x, val_y)
implicit none
integer(4) root, leaf, i, j
integer(4) x(1:leaf), val_x
character(1) y(1:leaf), val_y
write (*, '(2x,a,i0)') 'target ', x(root)
i = root
j = i*2
do
if (j > leaf) exit ! *子がなくなったら終了
write (*, '(4x,a)') 'step'
call output_current_heap(x, N)
if (j < leaf) then
if (x(j) >= x(j + 1)) then
write (*, '(8x,a,i0,a,i0,a,i0,a)') '→ ', x(j), ' >= ', x(j + 1), ' ：', x(j + 1), ' を採用'
j = j + 1 ! *子が2つある場合は、大きい方を x(j) とする。
else
write (*, '(8x,a,i0,a,i0,a,i0,a)') '→ ', x(j), ' < ', x(j + 1), ' ：', x(j), ' を採用'
end if
end if
if (x(j) <= val_x) then
! *子の方が大きければ x(j) を x(i) に上げた後
! *i=jにして、1つ下を検討候補に入れる。
! *一つ下がなければ、j>leafとなり配列の参照先がない=終了となる。
x(i) = x(j)
y(i) = y(j)
write (*, '(8x,a,i0,a,i0,a)') '→ ', x(j), ' <= ', val_x, ' ：入れ替えする'
x(j) = val_x
i = j
j = i*2
else
! *親の方が大きければ何もしないので、leaf+1して次のexitの判定で、do文の外に出す
write (*, '(8x,a,i0,a,i0,a)') '→ ', x(j), ' > ', val_x, ' ：入れ替えしない'
j = leaf + 1
end if
end do
! *値を入れ替える(子jを一つ上に上げる処理、L95)をすると、親iの値が消えてしまうので、本来は直後にx(j)にx(i)の値を入れておかなければいけない。
! *しかし、下に下がる親iの値は常に同じなので、入れ替えの処理をせずにvalに入れて管理している。
! *入れ替える対象(子j)が無くなった時点で、場所がrootの位置が確定するので、最後にx(i)=valで値を入れている。
x(i) = val_x
y(i) = val_y
return
end subroutine makeheap
subroutine output_current_heap(x, N)
integer i, j, k
integer(4) N
integer(4) x(N)
i = 1
k = 1
do
j = i
write (*, '(6x,i0,a,1x)', advance='no') k, ' |'
do
if (j + 1 > 2*i - 1 .or. (j + 1 > N)) then
write (*, '(2x,i0)') x(j)
exit
else
write (*, '(2x,i0)', advance='no') x(j)
j = j + 1
end if
end do
i = i*2
k = k + 1
if (i > N) exit
end do
end subroutine output_current_heap
end