Solve the no connection puzzle: Difference between revisions
Content added Content deleted
No edit summary |
|||
Line 1,574: | Line 1,574: | ||
\ | X | / |
\ | X | / |
||
\|/ \|/ |
\|/ \|/ |
||
5 6 |
|||
</pre> |
|||
=={{header|Fortran}}== |
|||
{{works with|gfortran|11.2.1}} |
|||
<lang fortran>! This is free and unencumbered software released into the public domain. |
|||
! |
|||
! Anyone is free to copy, modify, publish, use, compile, sell, or |
|||
! distribute this software, either in source code form or as a compiled |
|||
! binary, for any purpose, commercial or non-commercial, and by any |
|||
! means. |
|||
! |
|||
! In jurisdictions that recognize copyright laws, the author or authors |
|||
! of this software dedicate any and all copyright interest in the |
|||
! software to the public domain. We make this dedication for the benefit |
|||
! of the public at large and to the detriment of our heirs and |
|||
! successors. We intend this dedication to be an overt act of |
|||
! relinquishment in perpetuity of all present and future rights to this |
|||
! software under copyright law. |
|||
! |
|||
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, |
|||
! EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF |
|||
! MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. |
|||
! IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR |
|||
! OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, |
|||
! ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR |
|||
! OTHER DEALINGS IN THE SOFTWARE. |
|||
! |
|||
! For more information, please refer to <http://unlicense.org/> |
|||
program no_connection_puzzle |
|||
! The names of the holes. |
|||
integer, parameter :: a = 1 |
|||
integer, parameter :: b = 2 |
|||
integer, parameter :: c = 3 |
|||
integer, parameter :: d = 4 |
|||
integer, parameter :: e = 5 |
|||
integer, parameter :: f = 6 |
|||
integer, parameter :: g = 7 |
|||
integer, parameter :: h = 8 |
|||
integer :: holes(a:h) |
|||
call find_solutions (holes, a) |
|||
contains |
|||
recursive subroutine find_solutions (holes, current_hole_index) |
|||
integer, intent(inout) :: holes(a:h) |
|||
integer, intent(in) :: current_hole_index |
|||
integer :: peg_number |
|||
! Recursively construct and print possible solutions, quitting |
|||
! any partial solution that does not satisfy constraints. |
|||
do peg_number = 1, 8 |
|||
holes(current_hole_index) = peg_number |
|||
if (satisfies_the_constraints (holes, current_hole_index)) then |
|||
if (current_hole_index == h) then |
|||
call print_solution (holes) |
|||
write (*, '()') |
|||
else |
|||
call find_solutions (holes, current_hole_index + 1) |
|||
end if |
|||
end if |
|||
end do |
|||
end subroutine find_solutions |
|||
function satisfies_the_constraints (holes, i) result (satisfies) |
|||
integer, intent(inout) :: holes(a:h) |
|||
integer, intent(in) :: i ! Where the new peg goes. |
|||
logical :: satisfies |
|||
integer :: j |
|||
integer :: product |
|||
! The most recently inserted peg must not be a duplicate of one |
|||
! already inserted. |
|||
satisfies = all (holes(a : i - 1) /= holes(i)) |
|||
if (satisfies) then |
|||
! ‘Fill’ the unfilled holes with fake pegs that cause |
|||
! differences with them always to be larger than 1. |
|||
do j = i + 1, h |
|||
holes(j) = 100 * j |
|||
end do |
|||
! Check that the differences are satisfactory. |
|||
satisfies = 1 < abs (holes(a) - holes(c)) .and. & |
|||
& 1 < abs (holes(a) - holes(d)) .and. & |
|||
& 1 < abs (holes(a) - holes(e)) .and. & |
|||
& 1 < abs (holes(c) - holes(g)) .and. & |
|||
& 1 < abs (holes(d) - holes(g)) .and. & |
|||
& 1 < abs (holes(e) - holes(g)) .and. & |
|||
& 1 < abs (holes(b) - holes(d)) .and. & |
|||
& 1 < abs (holes(b) - holes(e)) .and. & |
|||
& 1 < abs (holes(b) - holes(f)) .and. & |
|||
& 1 < abs (holes(d) - holes(h)) .and. & |
|||
& 1 < abs (holes(e) - holes(h)) .and. & |
|||
& 1 < abs (holes(f) - holes(h)) .and. & |
|||
& 1 < abs (holes(c) - holes(d)) .and. & |
|||
& 1 < abs (holes(d) - holes(e)) .and. & |
|||
& 1 < abs (holes(e) - holes(f)) |
|||
end if |
|||
end function satisfies_the_constraints |
|||
subroutine print_solution (holes) |
|||
integer, intent(in) :: holes(a:h) |
|||
write (*, '(I5, I4)') holes(a), holes(b) |
|||
write (*, '(" /│\ /│\")') |
|||
write (*, '(" / │ X │ \")') |
|||
write (*, '(" / │/ \│ \")') |
|||
write (*, '(3(I1, "───"), I1)') holes(c), holes(d), holes(e), holes(f) |
|||
write (*, '(" \ │\ /│ /")') |
|||
write (*, '(" \ │ X │ /")') |
|||
write (*, '(" \│/ \│/")') |
|||
write (*, '(I5, I4)') holes(g), holes(h) |
|||
end subroutine print_solution |
|||
end program no_connection_puzzle</lang> |
|||
The first solution printed: |
|||
{{out}} |
|||
<pre> |
|||
3 4 |
|||
/│\ /│\ |
|||
/ │ X │ \ |
|||
/ │/ \│ \ |
|||
7───1───8───2 |
|||
\ │\ /│ / |
|||
\ │ X │ / |
|||
\│/ \│/ |
|||
5 6 |
5 6 |
||
</pre> |
</pre> |