Fortranでエイトクイーンパズル

エイトクイーンパズル

チェスの盤上に8つのクイーンを置いて, 各々が各々に取られないような配置にするパズル.

Fortranでの実装

カモノハシ本のnクイーンのアルゴリズムを参考にして, Fortranで実装した.

module

• neighborポインタに左のクイーンを指させる.
• find_sol関数でオブジェクト同士の通信で左のやつに取られないような位置へ移動する.
• チェス盤の大きさは max_rowと queen_tオブジェクトの数で決まる.
• null()を引数として渡せないっぽいのでイニシャライザ関数を2つ用意している.
• Fortranでは recursiveを付けないと再帰関数を定義できない.

ソースコード

module queen_m
  use, intrinsic :: iso_fortran_env
  implicit none

  type queen_t
     private
     integer                :: row, col
     type(queen_t), pointer :: neighbor
     integer                :: max_row
   contains
     procedure, pass :: find_solution => find_solution_q
     procedure, pass :: can_attack    => can_attack_q
     procedure, pass :: advance       => advance_q
     procedure, pass :: print         => print_q
     final :: destroy_queen
  end type queen_t

  interface queen_t
     module procedure :: initialize_left, initialize_q
  end interface queen_t

contains

  impure function initialize_left(col, max_row) result(res_q)
    type(queen_t)       :: res_q
    integer, intent(in) :: col, max_row
    res_q%row     = 1
    res_q%col     = col
    res_q%max_row = max_row
    res_q%neighbor => null()
    return
  end function initialize_left

  impure function initialize_q(col, max_row, queen) result(res_q)
    type(queen_t)                     :: res_q
    integer              , intent(in) :: col, max_row
    type(queen_t), target, intent(in) :: queen
    res_q%row     = 1
    res_q%col     = col
    res_q%max_row = max_row
    res_q%neighbor => queen
    return
  end function initialize_q

  subroutine destroy_queen(this)
    type(queen_t), intent(inout) :: this
    write(error_unit, '(a, i0, a, i0, a)') "destroyed: (", this%row, ", ", this%col, ")"
  end subroutine destroy_queen

  impure recursive logical function find_solution_q(this)
    class(queen_t), intent(inout) :: this
    do
       if (.not. associated(this%neighbor)) exit
       if (.not. this%neighbor%can_attack(this%row, this%col)) exit
       if (.not. this%advance()) then
          find_solution_q = .false.
          return
       end if
    end do
    find_solution_q = .true.
    return
  end function find_solution_q

  pure recursive logical function can_attack_q(this, test_row, test_col) result(attackable)
    class(queen_t), intent(in) :: this
    integer      , intent(in) :: test_row, test_col
    integer                   :: column_diff
    if (this%row == test_row) then
       attackable = .true.
       return
    end if

    column_diff = test_col - this%col
    if ( this%row + column_diff == test_row .or.&
         this%row - column_diff == test_row ) then
       attackable = .true.
       return
    end if

    if (associated(this%neighbor)) then
       attackable = this%neighbor%can_attack(test_row, test_col)
    else
       attackable = .false.
    end if
    return
  end function can_attack_q

  impure recursive logical function advance_q(this)
    class(queen_t), intent(inout) :: this
    if (this%row < this%max_row) then
       this%row = this%row + 1
       advance_q = this%find_solution()
       return
    end if

    if (.not. this%neighbor%advance()) then
       advance_q = .false.
       return
    end if
    this%row = 1
    advance_q = this%find_solution()
    return
  end function advance_q

  recursive subroutine print_q(this)
    class(queen_t), intent(in) :: this
    if (associated(this%neighbor)) then
       call this%neighbor%print()
    end if
    write(output_unit, *) this%row, this%col
  end subroutine print_q

end module queen_m

本体

• 10x10のチェス盤にクイーンを置いた.
• Fortranには new 演算子みたいなものが(多分)なくて, 変数に新しいオブジェクトを代入してもアドレスが変わらないっぽい(?)ので, queen_t オブジェクトを配列で宣言した.
• 関数の返り値は can_find変数で受ける必要がある.

program find_sol
  use, intrinsic :: iso_fortran_env
  use queen_m
  implicit none
  integer, parameter :: num_queen = 10
  integer            :: i
  logical            :: can_find
  type(queen_t)      :: queen(num_queen)

  queen(1) = queen_t(1, num_queen)
  do i = 2, num_queen
     queen(i) = queen_t(i, num_queen, queen(i-1))
     can_find = queen(i)%find_solution()
  end do

  call queen(num_queen)%print()
end program find_sol

実行結果

$ ./eight_queen.out
           1           1
           3           2
           6           3
           8           4
          10           5
           5           6
           9           7
           2           8
           4           9
           7          10

図に書くと

|*| | | | | | | | | |
| | |*| | | | | | | |
| | | | | |*| | | | |
| | | | | | | |*| | |
| | | | | | | | | |*|
| | | | |*| | | | | |
| | | | | | | | |*| |
| |*| | | | | | | | |
| | | |*| | | | | | |
| | | | | | |*| | | |

となる.