Peaceful chess queen armies: Difference between revisions
Content added Content deleted
Line 2,581: | Line 2,581: | ||
◦ • ◦ W ◦ • ◦ |
◦ • ◦ W ◦ • ◦ |
||
W ◦ W W • ◦ • </pre> |
W ◦ W W • ◦ • </pre> |
||
=={{header|Fortran}}== |
|||
{{works with|gfortran|11.2.1}} |
|||
There are two Fortran programs and a driver script. One program generates a Fortran module for basic operations; the other program (which must be linked with the generated module) does the actual work. The driver script is for Unix shell. |
|||
Here is the first program, '''peaceful_queens_elements_generator.f90''', which generates code to deal with the representations of the armies as integers: |
|||
<lang fortran>program peaceful_queens_elements_generator |
|||
use, intrinsic :: iso_fortran_env, only: int64 |
|||
use, intrinsic :: iso_fortran_env, only: error_unit |
|||
implicit none |
|||
! 64-bit integers, for boards up to 8-by-8. |
|||
integer, parameter :: kind8x8 = int64 |
|||
! 128-bit integers, for boards up to 11-by-11. |
|||
! This value is correct for gfortran. |
|||
integer, parameter :: kind11x11 = 16 |
|||
integer(kind = kind11x11), parameter :: one = 1 |
|||
integer(kind = kind11x11), parameter :: two = 2 |
|||
integer, parameter :: n_max = 11 |
|||
integer(kind = kind11x11) :: rook1_masks(0 : n_max - 1) |
|||
integer(kind = kind11x11) :: rook2_masks(0 : n_max - 1) |
|||
integer(kind = kind11x11) :: bishop1_masks(0 : (2 * n_max) - 4) |
|||
integer(kind = kind11x11) :: bishop2_masks(0 : (2 * n_max) - 4) |
|||
! Combines rook1_masks and rook2_masks. |
|||
integer(kind = kind11x11) :: rook_masks(0 : (2 * n_max) - 1) |
|||
! Combines bishop1_masks and bishop2_masks. |
|||
integer(kind = kind11x11) :: bishop_masks(0 : (4 * n_max) - 7) |
|||
! Combines rook and bishop masks. |
|||
integer(kind = kind11x11) :: queen_masks(0 : (6 * n_max) - 7) |
|||
character(len = 16), parameter :: s_kind8x8 = "kind8x8 " |
|||
character(len = 16), parameter :: s_kind11x11 = "kind11x11 " |
|||
character(200) :: arg |
|||
integer :: arg_count |
|||
integer :: m, n, max_solutions |
|||
integer :: board_kind |
|||
arg_count = command_argument_count () |
|||
if (arg_count /= 3) then |
|||
call get_command_argument (0, arg) |
|||
write (error_unit, '("Usage: ", A, " M N MAX_SOLUTIONS")') trim (arg) |
|||
stop 1 |
|||
end if |
|||
call get_command_argument (1, arg) |
|||
read (arg, *) m |
|||
if (m < 1) then |
|||
write (error_unit, '("M must be between 1 or greater.")') |
|||
stop 2 |
|||
end if |
|||
call get_command_argument (2, arg) |
|||
read (arg, *) n |
|||
if (n < 3 .or. 11 < n) then |
|||
write (error_unit, '("N must be between 3 and ", I0, ", inclusive.")') n_max |
|||
stop 2 |
|||
end if |
|||
call get_command_argument (3, arg) |
|||
read (arg, *) max_solutions |
|||
write (*, '("module peaceful_queens_elements")') |
|||
write (*, '()') |
|||
write (*, '(" use, intrinsic :: iso_fortran_env, only: int64")') |
|||
write (*, '()') |
|||
write (*, '(" implicit none")') |
|||
write (*, '(" private")') |
|||
write (*, '()') |
|||
write (*, '(" integer, parameter, public :: m = ", I0)') m |
|||
write (*, '(" integer, parameter, public :: n = ", I0)') n |
|||
write (*, '(" integer, parameter, public :: max_solutions = ", I0)') max_solutions |
|||
write (*, '()') |
|||
if (n <= 8) then |
|||
write (*, '(" ! 64-bit integers, for boards up to 8-by-8.")') |
|||
write (*, '(" integer, parameter, private :: kind8x8 = int64")') |
|||
else |
|||
write (*, '(" ! 128-bit integers, for boards up to 11-by-11.")') |
|||
write (*, '(" integer, parameter, private :: kind11x11 = ", I0)') kind11x11 |
|||
end if |
|||
write (*, '(" integer, parameter, public :: board_kind = ", A)') trim (s_kindnxn (n)) |
|||
write (*, '()') |
|||
write (*, '()') |
|||
write (*, '(" public :: rooks1_attack_check")') |
|||
write (*, '(" public :: rooks2_attack_check")') |
|||
write (*, '(" public :: rooks_attack_check")') |
|||
write (*, '(" public :: bishops1_attack_check")') |
|||
write (*, '(" public :: bishops2_attack_check")') |
|||
write (*, '(" public :: bishops_attack_check")') |
|||
write (*, '(" public :: queens_attack_check")') |
|||
write (*, '()') |
|||
write (*, '(" public :: board_rotate90")') |
|||
write (*, '(" public :: board_rotate180")') |
|||
write (*, '(" public :: board_rotate270")') |
|||
write (*, '(" public :: board_reflect1")') |
|||
write (*, '(" public :: board_reflect2")') |
|||
write (*, '(" public :: board_reflect3")') |
|||
write (*, '(" public :: board_reflect4")') |
|||
write (*, '()') |
|||
call write_rook1_masks |
|||
call write_rook2_masks |
|||
call write_bishop1_masks |
|||
call write_bishop2_masks |
|||
call write_rook_masks |
|||
call write_bishop_masks |
|||
call write_queen_masks |
|||
write (*, '("contains")') |
|||
write (*, '()') |
|||
call write_rooks1_attack_check |
|||
call write_rooks2_attack_check |
|||
call write_bishops1_attack_check |
|||
call write_bishops2_attack_check |
|||
call write_rooks_attack_check |
|||
call write_bishops_attack_check |
|||
call write_queens_attack_check |
|||
call write_board_rotate90 |
|||
call write_board_rotate180 |
|||
call write_board_rotate270 |
|||
call write_board_reflect1 |
|||
call write_board_reflect2 |
|||
call write_board_reflect3 |
|||
call write_board_reflect4 |
|||
call write_insert_zeros |
|||
call write_reverse_insert_zeros |
|||
write (*, '("end module peaceful_queens_elements")') |
|||
contains |
|||
subroutine write_rook1_masks |
|||
integer :: i |
|||
call fill_masks (n) |
|||
do i = 0, n - 1 |
|||
write (*, '(" integer(kind = ", A, "), parameter :: rook1_mask_",& |
|||
& I0, "x", I0, "_", I0, " = int (z''", Z0.32, "'', kind & |
|||
&= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& |
|||
& rook1_masks(i), trim (s_kindnxn (n)) |
|||
end do |
|||
write (*, '()') |
|||
end subroutine write_rook1_masks |
|||
subroutine write_rook2_masks |
|||
integer :: i |
|||
call fill_masks (n) |
|||
do i = 0, n - 1 |
|||
write (*, '(" integer(kind = ", A, "), parameter :: rook2_mask_",& |
|||
& I0, "x", I0, "_", I0, " = int (z''", Z0.32, "'', kind & |
|||
&= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& |
|||
& rook2_masks(i), trim (s_kindnxn (n)) |
|||
end do |
|||
write (*, '()') |
|||
end subroutine write_rook2_masks |
|||
subroutine write_bishop1_masks |
|||
integer :: i |
|||
call fill_masks (n) |
|||
do i = 0, (2 * n) - 4 |
|||
write (*, '(" integer(kind = ", A, "), parameter :: bishop1_mask_",& |
|||
& I0, "x", I0, "_", I0, " = int (z''", Z0.32, "'', kind & |
|||
&= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& |
|||
& bishop1_masks(i), trim (s_kindnxn (n)) |
|||
end do |
|||
write (*, '()') |
|||
end subroutine write_bishop1_masks |
|||
subroutine write_bishop2_masks |
|||
integer :: i |
|||
call fill_masks (n) |
|||
do i = 0, (2 * n) - 4 |
|||
write (*, '(" integer(kind = ", A, "), parameter :: bishop2_mask_",& |
|||
& I0, "x", I0, "_", I0, " = int (z''", Z0.32, "'', kind & |
|||
&= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& |
|||
& bishop2_masks(i), trim (s_kindnxn (n)) |
|||
end do |
|||
write (*, '()') |
|||
end subroutine write_bishop2_masks |
|||
subroutine write_rook_masks |
|||
integer :: i |
|||
call fill_masks (n) |
|||
do i = 0, (2 * n) - 1 |
|||
write (*, '(" integer(kind = ", A, "), parameter :: rook_mask_",& |
|||
& I0, "x", I0, "_", I0, " = int (z''", Z0.32, "'', kind & |
|||
&= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& |
|||
& rook_masks(i), trim (s_kindnxn (n)) |
|||
end do |
|||
write (*, '()') |
|||
end subroutine write_rook_masks |
|||
subroutine write_bishop_masks |
|||
integer :: i |
|||
call fill_masks (n) |
|||
do i = 0, (4 * n) - 7 |
|||
write (*, '(" integer(kind = ", A, "), parameter :: bishop_mask_",& |
|||
& I0, "x", I0, "_", I0, " = int (z''", Z0.32, "'', kind & |
|||
&= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& |
|||
& bishop_masks(i), trim (s_kindnxn (n)) |
|||
end do |
|||
write (*, '()') |
|||
end subroutine write_bishop_masks |
|||
subroutine write_queen_masks |
|||
integer :: i |
|||
call fill_masks (n) |
|||
do i = 0, (6 * n) - 7 |
|||
write (*, '(" integer(kind = ", A, "), parameter :: queen_mask_",& |
|||
& I0, "x", I0, "_", I0, " = int (z''", Z0.32, "'', kind & |
|||
&= ", A, ")")') trim (s_kindnxn (n)), n, n, i,& |
|||
& queen_masks(i), trim (s_kindnxn (n)) |
|||
end do |
|||
write (*, '()') |
|||
end subroutine write_queen_masks |
|||
subroutine write_rooks1_attack_check |
|||
integer :: i |
|||
write (*, '(" elemental function rooks1_attack_check (army1, army2) result (attacking)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) |
|||
write (*, '(" logical :: attacking")') |
|||
write (*, '()') |
|||
write (*, '(" attacking = ((iand (army1, rook1_mask_", I0, "x", I0,& |
|||
& "_0) /= 0) .and. (iand (army2, rook1_mask_", I0, "x", I0, "_0) /=& |
|||
& 0)) .or. &")') n, n, n, n |
|||
do i = 1, n - 1 |
|||
write (*, '(" & ((iand (army1, rook1_mask_", I0, "x",& |
|||
& I0, "_", I0, ") /= 0) .and. (iand (army2, rook1_mask_", I0,& |
|||
& "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i |
|||
if (i /= n - 1) then |
|||
write (*, '(" .or. &")') |
|||
else |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function rooks1_attack_check")') |
|||
write (*, '()') |
|||
end subroutine write_rooks1_attack_check |
|||
subroutine write_rooks2_attack_check |
|||
integer :: i |
|||
write (*, '(" elemental function rooks2_attack_check (army1, army2) result (attacking)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) |
|||
write (*, '(" logical :: attacking")') |
|||
write (*, '()') |
|||
write (*, '(" attacking = ((iand (army1, rook2_mask_", I0, "x", I0,& |
|||
& "_0) /= 0) .and. (iand (army2, rook2_mask_", I0, "x", I0, "_0) /=& |
|||
& 0)) .or. &")') n, n, n, n |
|||
do i = 1, n - 1 |
|||
write (*, '(" & ((iand (army1, rook2_mask_", I0, "x",& |
|||
& I0, "_", I0, ") /= 0) .and. (iand (army2, rook2_mask_", I0,& |
|||
& "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i |
|||
if (i /= n - 1) then |
|||
write (*, '(" .or. &")') |
|||
else |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function rooks2_attack_check")') |
|||
write (*, '()') |
|||
end subroutine write_rooks2_attack_check |
|||
subroutine write_bishops1_attack_check |
|||
integer :: i |
|||
write (*, '(" elemental function bishops1_attack_check (army1, army2) result (attacking)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) |
|||
write (*, '(" logical :: attacking")') |
|||
write (*, '()') |
|||
write (*, '(" attacking = ((iand (army1, bishop1_mask_", I0, "x", I0,& |
|||
& "_0) /= 0) .and. (iand (army2, bishop1_mask_", I0, "x", I0, "_0) /=& |
|||
& 0)) .or. &")') n, n, n, n |
|||
do i = 1, (2 * n) - 4 |
|||
write (*, '(" & ((iand (army1, bishop1_mask_", I0, "x",& |
|||
& I0, "_", I0, ") /= 0) .and. (iand (army2, bishop1_mask_", I0,& |
|||
& "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i |
|||
if (i /= (2 * n) - 4) then |
|||
write (*, '(" .or. &")') |
|||
else |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function bishops1_attack_check")') |
|||
write (*, '()') |
|||
end subroutine write_bishops1_attack_check |
|||
subroutine write_bishops2_attack_check |
|||
integer :: i |
|||
write (*, '(" elemental function bishops2_attack_check (army1, army2) result (attacking)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) |
|||
write (*, '(" logical :: attacking")') |
|||
write (*, '()') |
|||
write (*, '(" attacking = ((iand (army1, bishop2_mask_", I0, "x", I0,& |
|||
& "_0) /= 0) .and. (iand (army2, bishop2_mask_", I0, "x", I0, "_0) /=& |
|||
& 0)) .or. &")') n, n, n, n |
|||
do i = 1, (2 * n) - 4 |
|||
write (*, '(" & ((iand (army1, bishop2_mask_", I0, "x",& |
|||
& I0, "_", I0, ") /= 0) .and. (iand (army2, bishop2_mask_", I0,& |
|||
& "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i |
|||
if (i /= (2 * n) - 4) then |
|||
write (*, '(" .or. &")') |
|||
else |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function bishops2_attack_check")') |
|||
write (*, '()') |
|||
end subroutine write_bishops2_attack_check |
|||
subroutine write_rooks_attack_check |
|||
integer :: i |
|||
write (*, '(" elemental function rooks_attack_check (army1, army2) result (attacking)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) |
|||
write (*, '(" logical :: attacking")') |
|||
write (*, '()') |
|||
write (*, '(" attacking = ((iand (army1, rook_mask_", I0, "x", I0,& |
|||
& "_0) /= 0) .and. (iand (army2, rook_mask_", I0, "x", I0, "_0) /=& |
|||
& 0)) .or. &")') n, n, n, n |
|||
do i = 1, (2 * n) - 1 |
|||
write (*, '(" & ((iand (army1, rook_mask_", I0, "x",& |
|||
& I0, "_", I0, ") /= 0) .and. (iand (army2, rook_mask_", I0,& |
|||
& "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i |
|||
if (i /= (2 * n) - 1) then |
|||
write (*, '(" .or. &")') |
|||
else |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function rooks_attack_check")') |
|||
write (*, '()') |
|||
end subroutine write_rooks_attack_check |
|||
subroutine write_bishops_attack_check |
|||
integer :: i |
|||
write (*, '(" elemental function bishops_attack_check (army1, army2) result (attacking)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) |
|||
write (*, '(" logical :: attacking")') |
|||
write (*, '()') |
|||
write (*, '(" attacking = ((iand (army1, bishop_mask_", I0, "x", I0,& |
|||
& "_0) /= 0) .and. (iand (army2, bishop_mask_", I0, "x", I0, "_0) /=& |
|||
& 0)) .or. &")') n, n, n, n |
|||
do i = 1, (4 * n) - 7 |
|||
write (*, '(" & ((iand (army1, bishop_mask_", I0, "x",& |
|||
& I0, "_", I0, ") /= 0) .and. (iand (army2, bishop_mask_", I0,& |
|||
& "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i |
|||
if (i /= (4 * n) - 7) then |
|||
write (*, '(" .or. &")') |
|||
else |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function bishops_attack_check")') |
|||
write (*, '()') |
|||
end subroutine write_bishops_attack_check |
|||
subroutine write_queens_attack_check |
|||
integer :: i |
|||
write (*, '(" elemental function queens_attack_check (army1, army2) result (attacking)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: army1, army2")') trim (s_kindnxn (n)) |
|||
write (*, '(" logical :: attacking")') |
|||
write (*, '()') |
|||
write (*, '(" attacking = ((iand (army1, queen_mask_", I0, "x", I0,& |
|||
& "_0) /= 0) .and. (iand (army2, queen_mask_", I0, "x", I0, "_0) /=& |
|||
& 0)) .or. &")') n, n, n, n |
|||
do i = 1, (6 * n) - 7 |
|||
write (*, '(" & ((iand (army1, queen_mask_", I0, "x",& |
|||
& I0, "_", I0, ") /= 0) .and. (iand (army2, queen_mask_", I0,& |
|||
& "x", I0, "_", I0, ") /= 0))")', advance = 'no') n, n, i, n, n, i |
|||
if (i /= (6 * n) - 7) then |
|||
write (*, '(" .or. &")') |
|||
else |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function queens_attack_check")') |
|||
write (*, '()') |
|||
end subroutine write_queens_attack_check |
|||
subroutine write_board_rotate90 |
|||
integer :: i, j |
|||
write (*, '(" elemental function board_rotate90 (a) result (b)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) |
|||
write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) |
|||
write (*, '()') |
|||
write (*, '(" ! Rotation 90 degrees in one of the orientations.")') |
|||
write (*, '()') |
|||
do i = 0, n - 1 |
|||
if (i == 0) then |
|||
write (*, '(" b = ")', advance = 'no') |
|||
else |
|||
write (*, '(" & ")', advance = 'no') |
|||
do j = 1, i |
|||
write (*, '(" ")', advance = 'no') |
|||
end do |
|||
end if |
|||
if (i /= n - 1) then |
|||
write (*, '("ior (ishft (reverse_insert_zeros_", I0, " (ishft& |
|||
& (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& |
|||
& I0, ")), ", I0, "), &")') n, n, n, i, -i * n, i |
|||
else |
|||
write (*, '(" ishft (reverse_insert_zeros_", I0, " (ishft& |
|||
& (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& |
|||
& I0, ")), ", I0, ")")', advance = 'no') n, n, n, i, -i * n, i |
|||
do j = 1, n - 1 |
|||
write (*, '(")")', advance = 'no') |
|||
end do |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function board_rotate90")') |
|||
write (*, '()') |
|||
end subroutine write_board_rotate90 |
|||
subroutine write_board_rotate180 |
|||
write (*, '(" elemental function board_rotate180 (a) result (b)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) |
|||
write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) |
|||
write (*, '()') |
|||
write (*, '(" ! Rotation 180 degrees.")') |
|||
write (*, '()') |
|||
write (*, '(" b = board_reflect1 (board_reflect2 (a))")') |
|||
write (*, '(" end function board_rotate180")') |
|||
write (*, '()') |
|||
end subroutine write_board_rotate180 |
|||
subroutine write_board_rotate270 |
|||
integer :: i, j |
|||
write (*, '(" elemental function board_rotate270 (a) result (b)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) |
|||
write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) |
|||
write (*, '()') |
|||
write (*, '(" ! Rotation 270 degrees in one of the orientations.")') |
|||
write (*, '()') |
|||
do i = 0, n - 1 |
|||
if (i == 0) then |
|||
write (*, '(" b = ")', advance = 'no') |
|||
else |
|||
write (*, '(" & ")', advance = 'no') |
|||
do j = 1, i |
|||
write (*, '(" ")', advance = 'no') |
|||
end do |
|||
end if |
|||
if (i /= n - 1) then |
|||
write (*, '("ior (ishft (insert_zeros_", I0, " (ishft& |
|||
& (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& |
|||
& I0, ")), ", I0, "), &")') n, n, n, i, -i * n, n - 1 - i |
|||
else |
|||
write (*, '(" ishft (insert_zeros_", I0, " (ishft& |
|||
& (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& |
|||
& I0, ")), ", I0, ")")', advance = 'no') n, n, n, i, -i * n, n - 1 - i |
|||
do j = 1, n - 1 |
|||
write (*, '(")")', advance = 'no') |
|||
end do |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function board_rotate270")') |
|||
write (*, '()') |
|||
end subroutine write_board_rotate270 |
|||
subroutine write_board_reflect1 |
|||
integer :: i, j |
|||
write (*, '(" elemental function board_reflect1 (a) result (b)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) |
|||
write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) |
|||
write (*, '()') |
|||
write (*, '(" ! Reflection of rows or columns.")') |
|||
write (*, '()') |
|||
do i = 0, n - 1 |
|||
if (i == 0) then |
|||
write (*, '(" b = ")', advance = 'no') |
|||
else |
|||
write (*, '(" & ")', advance = 'no') |
|||
do j = 1, i |
|||
write (*, '(" ")', advance = 'no') |
|||
end do |
|||
end if |
|||
if (i /= n - 1) then |
|||
write (*, '("ior (ishft (iand (rook2_mask_", I0, "x", I0, "_", I0, ", a), ", I0, "), &")') & |
|||
& n, n, i, (n - 1) - (2 * i) |
|||
else |
|||
write (*, '("ishft (iand (rook2_mask_", I0, "x", I0, "_", I0, ", a), ", I0, ")")', advance = 'no') & |
|||
& n, n, i, (n - 1) - (2 * i) |
|||
do j = 1, n - 1 |
|||
write (*, '(")")', advance = 'no') |
|||
end do |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function board_reflect1")') |
|||
write (*, '()') |
|||
end subroutine write_board_reflect1 |
|||
subroutine write_board_reflect2 |
|||
integer :: i, j |
|||
write (*, '(" elemental function board_reflect2 (a) result (b)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) |
|||
write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) |
|||
write (*, '()') |
|||
write (*, '(" ! Reflection of rows or columns.")') |
|||
write (*, '()') |
|||
do i = 0, n - 1 |
|||
if (i == 0) then |
|||
write (*, '(" b = ")', advance = 'no') |
|||
else |
|||
write (*, '(" & ")', advance = 'no') |
|||
do j = 1, i |
|||
write (*, '(" ")', advance = 'no') |
|||
end do |
|||
end if |
|||
if (i /= n - 1) then |
|||
write (*, '("ior (ishft (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ", I0, "), &")') & |
|||
& n, n, i, n * ((n - 1) - (2 * i)) |
|||
else |
|||
write (*, '("ishft (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ", I0, ")")', advance = 'no') & |
|||
& n, n, i, n * ((n - 1) - (2 * i)) |
|||
do j = 1, n - 1 |
|||
write (*, '(")")', advance = 'no') |
|||
end do |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function board_reflect2")') |
|||
write (*, '()') |
|||
end subroutine write_board_reflect2 |
|||
subroutine write_board_reflect3 |
|||
integer :: i, j |
|||
write (*, '(" elemental function board_reflect3 (a) result (b)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) |
|||
write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) |
|||
write (*, '()') |
|||
write (*, '(" ! Reflection around one of the two main diagonals.")') |
|||
write (*, '()') |
|||
do i = 0, n - 1 |
|||
if (i == 0) then |
|||
write (*, '(" b = ")', advance = 'no') |
|||
else |
|||
write (*, '(" & ")', advance = 'no') |
|||
do j = 1, i |
|||
write (*, '(" ")', advance = 'no') |
|||
end do |
|||
end if |
|||
if (i /= n - 1) then |
|||
write (*, '("ior (ishft (insert_zeros_", I0, " (ishft& |
|||
& (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& |
|||
& I0, ")), ", I0, "), &")') n, n, n, i, -i * n, i |
|||
else |
|||
write (*, '(" ishft (insert_zeros_", I0, " (ishft& |
|||
& (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& |
|||
& I0, ")), ", I0, ")")', advance = 'no') n, n, n, i, -i * n, i |
|||
do j = 1, n - 1 |
|||
write (*, '(")")', advance = 'no') |
|||
end do |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function board_reflect3")') |
|||
write (*, '()') |
|||
end subroutine write_board_reflect3 |
|||
subroutine write_board_reflect4 |
|||
integer :: i, j |
|||
write (*, '(" elemental function board_reflect4 (a) result (b)")') |
|||
write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) |
|||
write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) |
|||
write (*, '()') |
|||
write (*, '(" ! Reflection around one of the two main diagonals.")') |
|||
write (*, '()') |
|||
do i = 0, n - 1 |
|||
if (i == 0) then |
|||
write (*, '(" b = ")', advance = 'no') |
|||
else |
|||
write (*, '(" & ")', advance = 'no') |
|||
do j = 1, i |
|||
write (*, '(" ")', advance = 'no') |
|||
end do |
|||
end if |
|||
if (i /= n - 1) then |
|||
write (*, '("ior (ishft (reverse_insert_zeros_", I0, " (ishft& |
|||
& (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& |
|||
& I0, ")), ", I0, "), &")') n, n, n, i, -i * n, n - 1 - i |
|||
else |
|||
write (*, '(" ishft (reverse_insert_zeros_", I0, " (ishft& |
|||
& (iand (rook1_mask_", I0, "x", I0, "_", I0, ", a), ",& |
|||
& I0, ")), ", I0, ")")', advance = 'no') n, n, n, i, -i * n, n - 1 - i |
|||
do j = 1, n - 1 |
|||
write (*, '(")")', advance = 'no') |
|||
end do |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function board_reflect4")') |
|||
write (*, '()') |
|||
end subroutine write_board_reflect4 |
|||
subroutine write_insert_zeros |
|||
integer :: i, j |
|||
write (*, '(" elemental function insert_zeros_", I0, " (a) result (b)")') n |
|||
write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) |
|||
write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) |
|||
write (*, '()') |
|||
do i = 0, n - 1 |
|||
if (i == 0) then |
|||
write (*, '(" b = ")', advance = 'no') |
|||
else |
|||
write (*, '(" & ")', advance = 'no') |
|||
do j = 1, i |
|||
write (*, '(" ")', advance = 'no') |
|||
end do |
|||
end if |
|||
if (i /= n - 1) then |
|||
write (*, '("ior (ishft (ibits (a, ", I0, ", 1), ", I0, "), &")') i, i * n |
|||
else |
|||
write (*, '("ishft (ibits (a, ", I0, ", 1), ", I0, ")")', advance = 'no') i, i * n |
|||
do j = 1, n - 1 |
|||
write (*, '(")")', advance = 'no') |
|||
end do |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function insert_zeros_", I0)') n |
|||
write (*, '()') |
|||
end subroutine write_insert_zeros |
|||
subroutine write_reverse_insert_zeros |
|||
integer :: i, j |
|||
write (*, '(" elemental function reverse_insert_zeros_", I0, " (a) result (b)")') n |
|||
write (*, '(" integer(kind = ", A, "), value :: a")') trim (s_kindnxn (n)) |
|||
write (*, '(" integer(kind = ", A, ") :: b")') trim (s_kindnxn (n)) |
|||
write (*, '()') |
|||
do i = 0, n - 1 |
|||
if (i == 0) then |
|||
write (*, '(" b = ")', advance = 'no') |
|||
else |
|||
write (*, '(" & ")', advance = 'no') |
|||
do j = 1, i |
|||
write (*, '(" ")', advance = 'no') |
|||
end do |
|||
end if |
|||
if (i /= n - 1) then |
|||
write (*, '("ior (ishft (ibits (a, ", I0, ", 1), ", I0, "), &")') n - 1 - i, i * n |
|||
else |
|||
write (*, '("ishft (ibits (a, ", I0, ", 1), ", I0, ")")', advance = 'no') n - 1 - i, i * n |
|||
do j = 1, n - 1 |
|||
write (*, '(")")', advance = 'no') |
|||
end do |
|||
write (*, '()') |
|||
end if |
|||
end do |
|||
write (*, '(" end function reverse_insert_zeros_", I0)') n |
|||
write (*, '()') |
|||
end subroutine write_reverse_insert_zeros |
|||
function s_kindnxn (n) result (s) |
|||
integer, intent(in) :: n |
|||
character(len = 16) :: s |
|||
if (n <= 8) then |
|||
s = s_kind8x8 |
|||
else |
|||
s = s_kind11x11 |
|||
end if |
|||
end function s_kindnxn |
|||
subroutine fill_masks (n) |
|||
integer, intent(in) :: n |
|||
call fill_rook1_masks (n) |
|||
call fill_rook2_masks (n) |
|||
call fill_bishop1_masks (n) |
|||
call fill_bishop2_masks (n) |
|||
call fill_rook_masks (n) |
|||
call fill_bishop_masks (n) |
|||
call fill_queen_masks (n) |
|||
end subroutine fill_masks |
|||
subroutine fill_rook1_masks (n) |
|||
integer, intent(in) :: n |
|||
integer :: i |
|||
integer(kind = kind11x11) :: mask |
|||
mask = (two ** n) - 1 |
|||
do i = 0, n - 1 |
|||
rook1_masks(i) = mask |
|||
mask = ishft (mask, n) |
|||
end do |
|||
end subroutine fill_rook1_masks |
|||
subroutine fill_rook2_masks (n) |
|||
integer, intent(in) :: n |
|||
integer :: i |
|||
integer(kind = kind11x11) :: mask |
|||
mask = 0 |
|||
do i = 0, n - 1 |
|||
mask = ior (ishft (mask, n), one) |
|||
end do |
|||
do i = 0, n - 1 |
|||
rook2_masks(i) = mask |
|||
mask = ishft (mask, 1) |
|||
end do |
|||
end subroutine fill_rook2_masks |
|||
subroutine fill_bishop1_masks (n) |
|||
integer, intent(in) :: n |
|||
integer :: i, j, k |
|||
integer(kind = kind11x11) :: mask0, mask1 |
|||
! Masks for diagonals. Put them in order from most densely |
|||
! populated to least densely populated. |
|||
do k = 0, n - 2 |
|||
mask0 = 0 |
|||
mask1 = 0 |
|||
do i = k, n - 1 |
|||
j = i - k |
|||
mask0 = ior (mask0, ishft (one, i + (j * n))) |
|||
mask1 = ior (mask1, ishft (one, j + (i * n))) |
|||
end do |
|||
if (k == 0) then |
|||
bishop1_masks(0) = mask0 |
|||
else |
|||
bishop1_masks((2 * k) - 1) = mask0 |
|||
bishop1_masks(2 * k) = mask1 |
|||
end if |
|||
end do |
|||
end subroutine fill_bishop1_masks |
|||
subroutine fill_bishop2_masks (n) |
|||
integer, intent(in) :: n |
|||
integer :: i, j, k |
|||
integer :: i1, j1 |
|||
integer(kind = kind11x11) :: mask0, mask1 |
|||
! Masks for skew diagonals. Put them in order from most densely |
|||
! populated to least densely populated. |
|||
do k = 0, n - 2 |
|||
mask0 = 0 |
|||
mask1 = 0 |
|||
do i = k, n - 1 |
|||
j = i - k |
|||
i1 = n - 1 - i |
|||
j1 = n - 1 - j |
|||
mask0 = ior (mask0, ishft (one, j + (i1 * n))) |
|||
mask1 = ior (mask1, ishft (one, i + (j1 * n))) |
|||
end do |
|||
if (k == 0) then |
|||
bishop2_masks(0) = mask0 |
|||
else |
|||
bishop2_masks((2 * k) - 1) = mask0 |
|||
bishop2_masks(2 * k) = mask1 |
|||
end if |
|||
end do |
|||
end subroutine fill_bishop2_masks |
|||
subroutine fill_rook_masks (n) |
|||
integer, intent(in) :: n |
|||
rook_masks(0 : n - 1) = rook1_masks |
|||
rook_masks(n : (2 * n) - 1) = rook2_masks |
|||
end subroutine fill_rook_masks |
|||
subroutine fill_bishop_masks (n) |
|||
integer, intent(in) :: n |
|||
integer :: i |
|||
! Put the masks in order from most densely populated to least |
|||
! densely populated. |
|||
do i = 0, (2 * n) - 4 |
|||
bishop_masks(2 * i) = bishop1_masks(i) |
|||
bishop_masks((2 * i) + 1) = bishop2_masks(i) |
|||
end do |
|||
end subroutine fill_bishop_masks |
|||
subroutine fill_queen_masks (n) |
|||
integer, intent(in) :: n |
|||
queen_masks(0 : (2 * n) - 1) = rook_masks |
|||
queen_masks(2 * n : (6 * n) - 7) = bishop_masks |
|||
end subroutine fill_queen_masks |
|||
end program peaceful_queens_elements_generator</lang> |
|||
Here is the second program, '''peaceful_queens.f90''': |
|||
<lang fortran>module peaceful_queens_support |
|||
use, non_intrinsic :: peaceful_queens_elements |
|||
implicit none |
|||
private |
|||
public :: write_board |
|||
public :: write_board_without_spaces |
|||
public :: write_board_with_spaces |
|||
public :: save_a_solution |
|||
interface write_board |
|||
module procedure write_board_without_spaces |
|||
module procedure write_board_with_spaces |
|||
end interface write_board |
|||
contains |
|||
subroutine write_board_without_spaces (unit, army_b, army_w) |
|||
integer, intent(in) :: unit |
|||
integer(kind = board_kind), intent(in) :: army_b, army_w |
|||
call write_board_with_spaces (unit, army_b, army_w, 0) |
|||
end subroutine write_board_without_spaces |
|||
subroutine write_board_with_spaces (unit, army_b, army_w, num_spaces) |
|||
integer, intent(in) :: unit |
|||
integer(kind = board_kind), intent(in) :: army_b, army_w |
|||
integer, intent(in) :: num_spaces |
|||
integer(kind = board_kind), parameter :: zero = 0 |
|||
integer(kind = board_kind), parameter :: one = 1 |
|||
integer :: i, j |
|||
integer(kind = board_kind) :: rank_b, rank_w |
|||
integer(kind = board_kind) :: mask |
|||
character(1), allocatable :: queens(:) |
|||
character(4), allocatable :: rules(:) |
|||
character(1), allocatable :: spaces(:) |
|||
allocate (queens(0 : n - 1)) |
|||
allocate (rules(0 : n - 1)) |
|||
allocate (spaces(1 : num_spaces)) |
|||
rules = "----" |
|||
if (0 < num_spaces) then |
|||
spaces = " " ! For putting spaces after newlines. |
|||
end if |
|||
mask = not (ishft (not (zero), n)) |
|||
write (unit, '("+", 100(A4, "+"))') rules |
|||
do i = 0, n - 1 |
|||
rank_b = iand (mask, ishft (army_b, -i * n)) |
|||
rank_w = iand (mask, ishft (army_w, -i * n)) |
|||
do j = 0, n - 1 |
|||
if (iand (rank_b, ishft (one, j)) /= 0) then |
|||
queens(j) = "B" |
|||
else if (iand (rank_w, ishft (one, j)) /= 0) then |
|||
queens(j) = "W" |
|||
else |
|||
queens(j) = " " |
|||
end if |
|||
end do |
|||
write (unit, '(100A1)', advance = 'no') spaces |
|||
write (unit, '("|", 100(A3, " |"))') queens |
|||
write (unit, '(100A1)', advance = 'no') spaces |
|||
if (i /= n - 1) then |
|||
write (unit, '("+", 100(A4, "+"))') rules |
|||
else |
|||
write (unit, '("+", 100(A4, "+"))', advance = 'no') rules |
|||
end if |
|||
end do |
|||
end subroutine write_board_with_spaces |
|||
subroutine save_a_solution (army1, army2, num_solutions, armies1, armies2) |
|||
integer(kind = board_kind), intent(in) :: army1, army2 |
|||
integer, intent(inout) :: num_solutions |
|||
integer(kind = board_kind), intent(inout) :: armies1(1:8, 1:max_solutions) |
|||
integer(kind = board_kind), intent(inout) :: armies2(1:8, 1:max_solutions) |
|||
! A sanity check. |
|||
if (queens_attack_check (army1, army2)) then |
|||
error stop |
|||
end if |
|||
num_solutions = num_solutions + 1 |
|||
armies1(1, num_solutions) = army1 |
|||
armies1(2, num_solutions) = board_rotate90 (army1) |
|||
armies1(3, num_solutions) = board_rotate180 (army1) |
|||
armies1(4, num_solutions) = board_rotate270 (army1) |
|||
armies1(5, num_solutions) = board_reflect1 (army1) |
|||
armies1(6, num_solutions) = board_reflect2 (army1) |
|||
armies1(7, num_solutions) = board_reflect3 (army1) |
|||
armies1(8, num_solutions) = board_reflect4 (army1) |
|||
armies2(1, num_solutions) = army2 |
|||
armies2(2, num_solutions) = board_rotate90 (army2) |
|||
armies2(3, num_solutions) = board_rotate180 (army2) |
|||
armies2(4, num_solutions) = board_rotate270 (army2) |
|||
armies2(5, num_solutions) = board_reflect1 (army2) |
|||
armies2(6, num_solutions) = board_reflect2 (army2) |
|||
armies2(7, num_solutions) = board_reflect3 (army2) |
|||
armies2(8, num_solutions) = board_reflect4 (army2) |
|||
end subroutine save_a_solution |
|||
end module peaceful_queens_support |
|||
module peaceful_queens_solver |
|||
use, non_intrinsic :: peaceful_queens_elements |
|||
use, non_intrinsic :: peaceful_queens_support |
|||
implicit none |
|||
private |
|||
public :: solve_peaceful_queens |
|||
integer(kind = board_kind), parameter :: zero = 0_board_kind |
|||
integer(kind = board_kind), parameter :: one = 1_board_kind |
|||
integer(kind = board_kind), parameter :: two = 2_board_kind |
|||
contains |
|||
subroutine solve_peaceful_queens (unit, show_equivalents, & |
|||
& num_solutions, armies1, armies2) |
|||
integer, intent(in) :: unit |
|||
logical, intent(in) :: show_equivalents |
|||
integer, intent(out) :: num_solutions |
|||
integer(kind = board_kind), intent(out) :: armies1(1:8, 1:max_solutions) |
|||
integer(kind = board_kind), intent(out) :: armies2(1:8, 1:max_solutions) |
|||
call solve (zero, 0, 0, zero, 0, 0, 0) |
|||
contains |
|||
recursive subroutine solve (army1, rooklike11, rooklike12, & |
|||
& army2, rooklike21, rooklike22, index) |
|||
integer(kind = board_kind), value :: army1 |
|||
integer, value :: rooklike11, rooklike12 |
|||
integer(kind = board_kind), value :: army2 |
|||
integer, value :: rooklike21, rooklike22 |
|||
integer, value :: index |
|||
integer :: num_queens1 |
|||
integer :: num_queens2 |
|||
integer(kind = board_kind) :: new_army |
|||
integer(kind = board_kind) :: new_army_reversed |
|||
integer :: bit1, bit2 |
|||
logical :: skip |
|||
num_queens1 = popcnt (army1) |
|||
num_queens2 = popcnt (army2) |
|||
if (num_queens1 + num_queens2 == 2 * m) then |
|||
if (.not. is_a_duplicate (army1, army2, num_solutions, armies1, armies2)) then |
|||
call save_a_solution (army1, army2, num_solutions, armies1, armies2) |
|||
write (unit, '("Solution ", I0)') num_solutions |
|||
call write_board (unit, army1, army2) |
|||
write (unit, '()') |
|||
write (unit, '()') |
|||
call optionally_write_equivalents |
|||
end if |
|||
else if (num_queens1 - num_queens2 == 0) then |
|||
! It is time to add a queen to army1. |
|||
do while (num_solutions < max_solutions .and. index /= n**2) |
|||
skip = .false. |
|||
new_army = ior (army1, ishft (one, index)) |
|||
if (new_army == army1) then |
|||
skip = .true. |
|||
else if (index < n) then |
|||
new_army_reversed = board_reflect1 (new_army) |
|||
if (new_army_reversed < new_army) then |
|||
! Skip a bunch of board_reflect1 equivalents. |
|||
skip = .true. |
|||
end if |
|||
end if |
|||
if (skip) then |
|||
index = index + 1 |
|||
else |
|||
bit1 = ishft (1, index / n) |
|||
bit2 = ishft (1, mod (index, n)) |
|||
if (iand (rooklike21, bit1) /= 0) then |
|||
index = round_up_to_multiple (index + 1, n) |
|||
else if (iand (rooklike22, bit2) /= 0) then |
|||
index = index + 1 |
|||
else if (bishops_attack_check (new_army, army2)) then |
|||
index = index + 1 |
|||
else |
|||
call solve (new_army, & |
|||
& ior (rooklike11, bit1), & |
|||
& ior (rooklike12, bit2), & |
|||
& army2, rooklike21, rooklike22, & |
|||
& n) |
|||
index = index + 1 |
|||
end if |
|||
end if |
|||
end do |
|||
else |
|||
! It is time to add a queen to army2. |
|||
do while (num_solutions < max_solutions .and. index /= n**2) |
|||
new_army = ior (army2, ishft (one, index)) |
|||
skip = (new_army == army2) |
|||
if (skip) then |
|||
index = index + 1 |
|||
else |
|||
bit1 = ishft (1, index / n) |
|||
bit2 = ishft (1, mod (index, n)) |
|||
if (iand (rooklike11, bit1) /= 0) then |
|||
index = round_up_to_multiple (index + 1, n) |
|||
else if (iand (rooklike12, bit2) /= 0) then |
|||
index = index + 1 |
|||
else if (bishops_attack_check (army1, new_army)) then |
|||
index = index + 1 |
|||
else |
|||
call solve (army1, rooklike11, rooklike12, & |
|||
& new_army, & |
|||
& ior (rooklike21, bit1), & |
|||
& ior (rooklike22, bit2), & |
|||
& 0) |
|||
index = index + 1 |
|||
end if |
|||
end if |
|||
end do |
|||
end if |
|||
end subroutine solve |
|||
subroutine optionally_write_equivalents |
|||
integer :: i |
|||
if (show_equivalents) then |
|||
write (unit, '(5X)', advance = 'no') |
|||
write (unit, '("Equivalents")') |
|||
write (unit, '(5X)', advance = 'no') |
|||
call write_board (unit, armies2(1, num_solutions), armies1(1, num_solutions), 5) |
|||
write (unit, '()') |
|||
write (unit, '()') |
|||
do i = 2, 5 |
|||
if (all ((armies1(i, num_solutions) /= armies1(1 : i - 1, num_solutions) .or. & |
|||
& armies2(i, num_solutions) /= armies2(1 : i - 1, num_solutions)) .and. & |
|||
& (armies2(i, num_solutions) /= armies1(1 : i - 1, num_solutions) .or. & |
|||
& armies1(i, num_solutions) /= armies2(1 : i - 1, num_solutions)))) then |
|||
write (unit, '(5X)', advance = 'no') |
|||
call write_board (unit, armies1(i, num_solutions), armies2(i, num_solutions), 5) |
|||
write (unit, '()') |
|||
write (unit, '()') |
|||
write (unit, '(5X)', advance = 'no') |
|||
call write_board (unit, armies2(i, num_solutions), armies1(i, num_solutions), 5) |
|||
write (unit, '()') |
|||
write (unit, '()') |
|||
end if |
|||
end do |
|||
end if |
|||
end subroutine optionally_write_equivalents |
|||
end subroutine solve_peaceful_queens |
|||
elemental function round_up_to_multiple (x, n) result (y) |
|||
integer, value :: x, n |
|||
integer :: y |
|||
y = x + mod (n - mod (x, n), n) |
|||
end function round_up_to_multiple |
|||
pure function is_a_duplicate (army1, army2, num_solutions, armies1, armies2) result (is_dup) |
|||
integer(kind = board_kind), intent(in) :: army1, army2 |
|||
integer, intent(in) :: num_solutions |
|||
integer(kind = board_kind), intent(in) :: armies1(1:8, 1:max_solutions) |
|||
integer(kind = board_kind), intent(in) :: armies2(1:8, 1:max_solutions) |
|||
logical :: is_dup |
|||
is_dup = any ((army1 == armies1(:, 1:num_solutions) .and. & |
|||
& army2 == armies2(:, 1:num_solutions)) .or. & |
|||
& (army2 == armies1(:, 1:num_solutions) .and. & |
|||
& army1 == armies2(:, 1:num_solutions))) |
|||
end function is_a_duplicate |
|||
end module peaceful_queens_solver |
|||
program peaceful_queens |
|||
use, intrinsic :: iso_fortran_env, only: output_unit |
|||
use, non_intrinsic :: peaceful_queens_elements |
|||
use, non_intrinsic :: peaceful_queens_support |
|||
use, non_intrinsic :: peaceful_queens_solver |
|||
implicit none |
|||
integer :: num_solutions |
|||
logical :: show_equivalents |
|||
integer(kind = board_kind) :: armies1(1:8, 1:max_solutions) |
|||
integer(kind = board_kind) :: armies2(1:8, 1:max_solutions) |
|||
integer :: arg_count |
|||
character(len = 200) :: arg |
|||
show_equivalents = .false. |
|||
arg_count = command_argument_count () |
|||
if (1 <= arg_count) then |
|||
call get_command_argument (1, arg) |
|||
select case (trim (arg)) |
|||
case ('1', 't', 'T', 'true', 'y', 'Y', 'yes') |
|||
show_equivalents = .true. |
|||
end select |
|||
end if |
|||
call solve_peaceful_queens (output_unit, show_equivalents, & |
|||
& num_solutions, armies1, armies2) |
|||
end program peaceful_queens</lang> |
|||
Here is the driver script: |
|||
<lang sh>#!/bin/sh |
|||
# |
|||
# Driver script for peaceful_queens in Fortran. |
|||
# |
|||
if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1; then |
|||
emulate sh |
|||
fi |
|||
if test $# -ne 3 && test $# -ne 4; then |
|||
echo "Usage: $0 M N MAX_SOLUTIONS [SHOW_EQUIVALENTS]" |
|||
exit 1 |
|||
fi |
|||
M=${1} |
|||
N=${2} |
|||
MAX_SOLUTIONS=${3} |
|||
SHOW_EQUIVALENTS=${4} |
|||
RM_GENERATED_SRC=rm |
|||
#RM_GENERATED_SRC=: |
|||
CHECK=f |
|||
case ${CHECK} in |
|||
0 | f | F | false | N | n | no) FCCHECK="" ;; |
|||
1 | t | T | true | Y | y | yes) FCCHECK="-fcheck=all" ;; |
|||
*) echo 'CHECK is set incorrectly'; |
|||
exit 1 ;; |
|||
esac |
|||
FC="gfortran" |
|||
FCFLAGS="-std=f2018 -g -O3 -march=native -fno-stack-protector -Wall -Wextra ${FCCHECK}" |
|||
# If you have the graphite optimizer, here are some marginally helpful |
|||
# flags. They barely make a difference, for me. |
|||
FCFLAGS="${FCFLAGS} -funroll-loops -floop-nest-optimize" |
|||
RUN_IT="yes" |
|||
${FC} -o peaceful_queens_elements_generator peaceful_queens_elements_generator.f90 && |
|||
./peaceful_queens_elements_generator ${M} ${N} ${MAX_SOLUTIONS} > peaceful_queens_elements.f90 && |
|||
${FC} ${FCFLAGS} -c peaceful_queens_elements.f90 && |
|||
${RM_GENERATED_SRC} peaceful_queens_elements.f90 && |
|||
${FC} ${FCFLAGS} -c peaceful_queens.f90 && |
|||
${FC} ${FCFLAGS} -o peaceful_queens peaceful_queens_elements.o peaceful_queens.o && |
|||
if test x"${RUN_IT}" = xyes; then time ./peaceful_queens ${SHOW_EQUIVALENTS}; else :; fi</lang> |
|||
=={{header|Go}}== |
=={{header|Go}}== |