【Fortran】Fortranでヒープソートを実装する

## 目次
  - [概要](#概要)
  - [アルゴリズム](#アルゴリズム)
  - [プログラム例](#プログラム例)

## 概要
ヒープソートとは、データを**昇順**、**降順**に並び替えるアルゴリズムの１つです。
計算量は $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サイトのリンクを記載します。


https://ja.wikipedia.org/wiki/%E3%83%92%E3%83%BC%E3%83%97%E3%82%BD%E3%83%BC%E3%83%88

https://medium-company.com/%e3%83%92%e3%83%bc%e3%83%97%e3%82%bd%e3%83%bc%e3%83%88/


## プログラム例
``99  3  4  7 55  1  6  2``を降順に並び替えてみます。

### 実行結果
途中過程を含めたヒープソートによる並び替えの過程を以下に示します。

<details><summary>【実行結果】長いので畳んでいます。　</summary>

```
並び替え前  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
```
</details>


### サンプルプログラム

```fortran
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
```