【Fortran】FortranでDFS(深さ優先探索)を実装する

概要

深さ優先探索とは、グラフ探索(辺で繋がれた頂点の探索)に使う全探索アルゴリズムの１つです。
単純な２重、３重のDoループによる全探索と比較して、少ない計算量で探索を行うことができます。

深さ優先探索には、スタックによる方法と、再帰関数による方法の２種類の実装方法があります。
今回は、再帰関数を使ってDFSを実装します。

アルゴリズム

詳細なアルゴリズムは既に多くのWebサイトで解説されていますので、本記事では説明を省略します。
参考として、以下のWebサイトのリンクを記載します。

①：実際の計算手順について、ステップごとの丁寧な解説が載っています。

②：上記の①のサイトの問題について、WEBアプリケーションを用いて視覚的にアルゴリズムが理解できます。

プログラム例

対象とする問題

AtCoder Typical Contest 001のA問題を例にDFSを実装します。

問題としては、迷路のスタートからゴールまでの経路をDFSを使って探索し、ゴールできるならYes、出来ないならNoを出力する問題です。

問題のイメージとしては、前項で挙げた②の参考サイトと同じです。
DFSで経路を調べていく過程を知るためにも、一度見ておくと良いと思います。

プログラム例

DFSの部分をサブルーチンで定義しています。
注意点として、サブルーチンで再帰関数を定義する場合には、recursiveを頭につける必要があります。

module global_variable
    implicit none
    ! グローバル変数
    character(1), allocatable :: C(:, :)
    integer, allocatable::check_root(:, :)
    integer check_YN, H, W, goal(2)
end module

program ex_DFS
    use global_variable
    implicit none
    integer i, j
    !迷路のデータ入力
    read (*, *) H, W
    allocate (C(H, W), check_root(H, W))
    do i = 1, H
        read (*, '(*(a1))') (C(i, j), j=1, W)
    end do
    !スタート位置の検索
    tate: do i = 1, H
        yoko: do j = 1, W
            if (c(i, j) == 's') exit tate
        end do yoko
    end do tate
    write (*, "(a9,i3,a3,i3,a3)") 'Start = (', i, ' , ', j, '  )'
    !
    check_root = 0
    check_YN = 0
    call move(i, j)
    if (check_YN == 1) then
        write (*, "(a)") 'Yes'
        write (*, "(a9,i3,a3,i3,a3)") 'Goal = (', goal(1), ' , ', goal(2), '  )'
    else
        write (*, "(a)") 'No'
    end if

contains
!深さ優先探索
    recursive subroutine move(i, j)
        integer i, j
        if (i > 0 .and. i <= H .and. j <= W .and. j > 0) then
            !移動先が壁
            if (C(i, j) == '#') return
            !移動先がゴール
            if (C(i, j) == 'g') then
                check_YN = 1
                goal(1) = i
                goal(2) = j
                return
            end if
            !移動先が訪問済：終了
            if (check_root(i, j) == 1) then
                return
            else
                !移動先が道
                check_root(i, j) = 1
                call move(i + 1, j) !下
                call move(i - 1, j) !上
                call move(i, j + 1) !右
                call move(i, j - 1) !左
            end if
        else
            return
        end if
    end subroutine
end