From 48ca57c6a24d73e000a4fb85d843f88a5516e527 Mon Sep 17 00:00:00 2001 From: Norwid Behrnd Date: Tue, 12 Sep 2023 11:27:44 +0200 Subject: [PATCH] application of fprettify ruled reformat This commit combines the application of the fprettify rule based reformat with additional manual edits (truncation of long lines, etc.) to eventually ease reading of git's reflogs and diff views. Reference arrays in check.f90 were protected by "fprettify fences" to retain some visual guide which does not affect the result of fpm test, nor the diff test launched by the Makefile. For the present project, with editors with syntax highlighting, I'm not sure if an horizontal alignment of variable declarations (and not only around `::`, as discussed on fprettify[1]) is of significant advantage here. [1] https://github.com/pseewald/fprettify/issues/157 Signed-off-by: Norwid Behrnd --- app/main.f90 | 244 ++++++------- src/sudoku.f90 | 932 ++++++++++++++++++++++++------------------------- test/check.f90 | 305 ++++++++-------- 3 files changed, 739 insertions(+), 742 deletions(-) diff --git a/app/main.f90 b/app/main.f90 index 1011e61..03d8816 100644 --- a/app/main.f90 +++ b/app/main.f90 @@ -16,147 +16,147 @@ ! If not, see . !------------------------------------------------------------------------------ ! Contributed by Vincent Magnin, 2006-11-27; Norwid Behrnd, 2023 -! Last modifications: 2023-09-05 +! Last modifications: 2023-09-12 !------------------------------------------------------------------------------ program main - use iso_fortran_env, only: dp => real64 - use sudoku + use iso_fortran_env, only: dp => real64 + use sudoku - implicit none - ! Variables locales : - integer, dimension(9, 9) :: grid ! (line, column) - real(kind=dp) :: Start,End ! monitor the duration of computation - integer :: choice - integer :: n_empty ! number of cells to clear - character(50) :: file ! file name (including extension .txt) + implicit none + ! Variables locales : + integer, dimension(9, 9) :: grid + real(kind=dp) :: Start, End ! monitor the duration of computation + integer :: choice + integer :: n_empty ! number of cells to clear + character(50) :: file ! file name (including extension .txt) - select case (command_argument_count()) - case (0) ! the typical invocation with `fpm run` + select case (command_argument_count()) + case (0) ! the typical invocation with `fpm run` ! initialize the pseudorandom number generator call Initialize_Random ! initialize an explicitly empty grid grid = 0 - print *,"sudoku.f90, version 0.8.1, copyright (C) 2006 Vincent MAGNIN" - ! provide a user menue + print *, "sudoku.f90, version 0.8.1, copyright (C) 2006 Vincent MAGNIN" + ! provide a user menu do - print * - print *,"*************************** MENU *****************************************" - print *,"1) Manual input (lines of comma separated 1 - 9, or 0 (empty cell).)" - print *,"2) Input from a text file. For permitted patterns, see the documentation." - print *,"3) Save the currently processed grid as a text file." - print *,"4) Check the validity of the grid currently stored in memory." - print *,"5) Display the grid currently stored in memory." - print *,"6) Create a random, already filled Sudoku grid." - print *,"7) Solve the Sudoku grid currently stored in memory." - print *,"8) Create a partially allocated grid (conjecture of a likely unique solution)." - print *,"9) Quit." - print *,"Select one of them and click `Enter`:" - READ *,choice + print * + print *, "*************************** MENU *****************************************" + print *, "1) Manual input (lines of comma separated 1 - 9, or 0 (empty cell).)" + print *, "2) Input from a text file. For permitted patterns, see the documentation." + print *, "3) Save the currently processed grid as a text file." + print *, "4) Check the validity of the grid currently stored in memory." + print *, "5) Display the grid currently stored in memory." + print *, "6) Create a random, already filled Sudoku grid." + print *, "7) Solve the Sudoku grid currently stored in memory." + print *, "8) Create a partially allocated grid (conjecture of a likely unique solution)." + print *, "9) Quit." + print *, "Select one of them and click `Enter`:" + READ *, choice - select case (choice) - case (1) - call Request_grid(grid) - print *,"You entered the following Sudoku:" - call Display_grid(grid) - if (ValidGrid(grid)) then - print *, "The Sudoku is valid." - else - print *, "The Sudoku is invalid." - end if - case(2) - print *,"Enter complete file name of the file to read (including .txt extension):" - call SYSTEM("dir *.txt") - READ *,file - call Read_grid(grid,trim(file)) - call Display_grid(grid) - if (ValidGrid(grid)) then - print *, "The Sudoku is valid." - else - print *, "The Sudoku is invalid." - end if - case(3) - print *,"Enter complete file name of the file to save (incl. .txt):" - READ *,file - call Save_grid(grid,trim(file)) - print *,"File saved." - case(4) - if (ValidGrid(grid)) then - print *, "The grid to process is valid." - else - print *, "The grid to process is invalid." - end if - case(5) - print *,"Below, the grid to process:" - call Display_grid(grid) - if (ValidGrid(grid)) then - print *, "The grid is valid." - else - print *, "The grid is invalid." - end if - case(6) - Start = Time() - call CreateFilledGrid(grid) - call Display_grid(grid) - ! grid validation: - if (ValidGrid(grid)) then - print *, "The grid is valid." - else - print *, "Computational error: the grid is invalid!" - end if - End = Time() - write (*, "(A, F12.3, A)") " computing time: ", End - Start, " s." - case(7) - print *,"Below, the grid submitted:" - call Display_grid(grid) - Start = Time() - call Solve_grid(grid) - if (ValidGrid(grid)) then - print *, "Below, the solved grid (validity was verified):" - else - print *, "The initial grid was invalid, impossible to solve …" - end if - call Display_grid(grid) - End = Time() - write (*, "(A, F12.3, A)") " computing time: ", End - Start, " s." - case(8) - print *,"How many numbers should be assigned in advance [17,81]?" - print *,"Note: with less than 35 preallocated fields, the computation rapidly takes longer!" - READ *,n_empty - call CreateFilledGrid(grid) - print *,"Below, a filled grid:" - call Display_grid(grid) - ! grid validation: - if (ValidGrid(grid)) then - print *, "The grid is valid." - else - print *, "The grid is invalid: problem to compute a solution!" - end if + select case (choice) + case (1) + call Request_grid(grid) + print *, "You entered the following Sudoku:" + call Display_grid(grid) + if (ValidGrid(grid)) then + print *, "The Sudoku is valid." + else + print *, "The Sudoku is invalid." + end if + case (2) + print *, "Enter complete file name of the file to read (including .txt extension):" + call SYSTEM("dir *.txt") + READ *, file + call Read_grid(grid, trim(file)) + call Display_grid(grid) + if (ValidGrid(grid)) then + print *, "The Sudoku is valid." + else + print *, "The Sudoku is invalid." + end if + case (3) + print *, "Enter complete file name of the file to save (incl. .txt):" + READ *, file + call Save_grid(grid, trim(file)) + print *, "File saved." + case (4) + if (ValidGrid(grid)) then + print *, "The grid to process is valid." + else + print *, "The grid to process is invalid." + end if + case (5) + print *, "Below, the grid to process:" + call Display_grid(grid) + if (ValidGrid(grid)) then + print *, "The grid is valid." + else + print *, "The grid is invalid." + end if + case (6) + Start = Time() + call CreateFilledGrid(grid) + call Display_grid(grid) + ! grid validation: + if (ValidGrid(grid)) then + print *, "The grid is valid." + else + print *, "Computational error: the grid is invalid!" + end if + End = Time() + write (*, "(A, F12.3, A)") " computing time: ", End - Start, " s." + case (7) + print *, "Below, the grid submitted:" + call Display_grid(grid) + Start = Time() + call Solve_grid(grid) + if (ValidGrid(grid)) then + print *, "Below, the solved grid (validity was verified):" + else + print *, "The initial grid was invalid, impossible to solve …" + end if + call Display_grid(grid) + End = Time() + write (*, "(A, F12.3, A)") " computing time: ", End - Start, " s." + case (8) + print *, "How many numbers should be assigned in advance [17,81]?" + print *, "Note: with less than 35 preallocated fields, the computation rapidly takes longer!" + READ *, n_empty + call CreateFilledGrid(grid) + print *, "Below, a filled grid:" + call Display_grid(grid) + ! grid validation: + if (ValidGrid(grid)) then + print *, "The grid is valid." + else + print *, "The grid is invalid: problem to compute a solution!" + end if - Start = Time() - call CreateSudokuGrid(grid,n_empty) - print *,"Below a Sudoku grid (assuming a likely unique solution):" - call Display_grid(grid) - if (ValidGrid(grid)) then - print *, "valid grid" - else - print *, "Invalid grid: problem to compute a solution!" - end if - End = Time() - write (*, "(A, F12.3, A)") " computing time: ", End - Start, " s." - case(9) - stop - end select + Start = Time() + call CreateSudokuGrid(grid, n_empty) + print *, "Below a Sudoku grid (assuming a likely unique solution):" + call Display_grid(grid) + if (ValidGrid(grid)) then + print *, "valid grid" + else + print *, "Invalid grid: problem to compute a solution!" + end if + End = Time() + write (*, "(A, F12.3, A)") " computing time: ", End - Start, " s." + case (9) + stop + end select end do - case (1) ! accessible only by direct invocation of the executable + case (1) ! accessible only by direct invocation of the executable call get_command_argument(1, file) call solver(grid, file) - case default + case default print *, "Parameters: enter either one, or none." - end select + end select end program main diff --git a/src/sudoku.f90 b/src/sudoku.f90 index f08a132..7234ce9 100644 --- a/src/sudoku.f90 +++ b/src/sudoku.f90 @@ -16,483 +16,475 @@ ! If not, see . !------------------------------------------------------------------------------ ! Contributed by Vincent Magnin, 2006-11-27; Norwid Behrnd, 2023 -! Last modifications: 2023-09-05 +! Last modifications: 2023-09-12 !------------------------------------------------------------------------------ module sudoku - use iso_fortran_env, only: dp => real64 - implicit none + use iso_fortran_env, only: dp => real64 + implicit none contains - subroutine Solve_grid(grid) - ! input/output parameters: - integer, dimension(9, 9), intent(inout) :: grid - ! local variables: - integer, dimension(9, 9) :: grid_0 ! - real(kind=dp) :: random ! random number - integer :: row,column,line_0,row_0,i,j - integer :: counter_empty_cells ! counter of empty/non allocated cells - integer, dimension(1:81,1:3) :: empty_cells ! list of empty cells - !logical, dimension(0:9) :: possible ! Possibility of each number - integer, dimension(1:9) :: possible_digit ! list of (still) possible numbers - integer :: counter_possible_digits ! counter of possible numbers - - possible_digit = 0 - - ! save the initial grid: - grid_0 = grid - - ! identify the grid coordinates of empty cells in the grid - ! in a table of 81 entries - empty_cells = 0 - counter_empty_cells = 0 - do row = 1,9 - do column =1,9 - if (grid(row,column) == 0) then - counter_empty_cells = counter_empty_cells+1 - empty_cells(counter_empty_cells,1) = row - empty_cells(counter_empty_cells,2) = column - !call list_possible_digits(grid,row,column,empty_cells(counter_empty_cells,3),possible_digit) - end if - end do - end do - - ! sort the empty cells: - !call Draw(empty_cells,1,counter_empty_cells) - - ! iterate over all empty cells: + subroutine Solve_grid(grid) + ! input/output parameters: + integer, dimension(9, 9), intent(inout) :: grid + ! local variables: + integer, dimension(9, 9) :: grid_0 ! empty grid + real(kind=dp) :: random ! random number + integer :: row, column, line_0, row_0, i, j + integer :: counter_empty_cells ! counter of empty/non allocated cells + integer, dimension(1:81, 1:3) :: empty_cells ! list of empty cells + ! logical, dimension(0:9) :: possible ! Possibility of each number + integer, dimension(1:9) :: possible_digit ! list of (still) possible numbers + integer :: counter_possible_digits ! counter of possible numbers + + possible_digit = 0 + + ! save the initial grid: + grid_0 = grid + + ! identify the grid coordinates of empty cells in the grid + ! in a table of 81 entries + empty_cells = 0 + counter_empty_cells = 0 + do row = 1, 9 + do column = 1, 9 + if (grid(row, column) == 0) then + counter_empty_cells = counter_empty_cells + 1 + empty_cells(counter_empty_cells, 1) = row + empty_cells(counter_empty_cells, 2) = column + ! call list_possible_digits(grid, row, column, & + ! empty_cells(counter_empty_cells,3), possible_digit) + end if + end do + end do + + ! sort the empty cells: + ! call Draw(empty_cells,1,counter_empty_cells) + + ! iterate over all empty cells: + i = 1 + do while (i <= counter_empty_cells) + ! To accelerate the algorithm, count for each empty cell the numbers + ! which yet possibly could be inserted + ! in this very cell + do j = i, counter_empty_cells + line_0 = empty_cells(j, 1) + row_0 = empty_cells(j, 2) + call list_possible_digits(grid, line_0, row_0, & + empty_cells(j, 3), possible_digit) + end do + ! retrieve the empty cells (which depends on the number of still + ! possible numbers) + call Draw(empty_cells, i, counter_empty_cells) + + ! for cell (line_0,row_0), generate a list of possible numbers: + line_0 = empty_cells(i, 1) + row_0 = empty_cells(i, 2) + + call list_possible_digits(grid, line_0, row_0, & + counter_possible_digits, possible_digit) + + ! if there are multiple possibilities, choose one (by chance) and + ! continue with the next empty cell: + if (counter_possible_digits > 1) then + call Random_number(random) + j = 1 + int(random * counter_possible_digits) + grid(line_0, row_0) = possible_digit(j) + i = i + 1 + ! if there is only one possibility, use this number now, and then + ! continue with the next empty cell + else if (counter_possible_digits == 1) then + grid(line_0, row_0) = possible_digit(1) + i = i + 1 + ! start all over again if there is none: + else i = 1 - do while (i <= counter_empty_cells) - ! To accelerate the algorithm, count for each empty cell the numbers - ! which yet possibly could be inserted - ! in this very cell - do j = i,counter_empty_cells - line_0 = empty_cells(j,1) - row_0 = empty_cells(j,2) - call list_possible_digits(grid,line_0,row_0,empty_cells(j,3),possible_digit) - end do - ! retrieve the empty cells (which depends on the number of still - ! possible numbers) - call Draw(empty_cells,i,counter_empty_cells) - - ! for cell (line_0,row_0), generate a list of possible numbers: - line_0 = empty_cells(i,1) - row_0 = empty_cells(i,2) - - call list_possible_digits(grid,line_0,row_0,counter_possible_digits,possible_digit) - - ! if there are multiple possibilities, choose one (by chance) and - ! continue with the next empty cell: - if (counter_possible_digits > 1) then - call Random_number(random) - j = 1+int(random*counter_possible_digits) - grid(line_0,row_0) = possible_digit(j) - i = i+1 - ! if there is only one possibility, use this number now, and then - ! continue with the next empty cell - else if (counter_possible_digits == 1) then - grid(line_0,row_0) = possible_digit(1) - i = i+1 - ! start all over again if there is none: - else - i = 1 - grid = grid_0 - end if - end do - end subroutine Solve_grid - - - ! procedure to create a list of allowed numbers in the present empty cell: - subroutine list_possible_digits(grid,line_0,row_0,counter_possible_digits,possible_digit) - ! input parameters: - integer, dimension(9, 9), intent(in) :: grid - integer :: line_0,row_0 - ! output parameters: - integer, dimension(1:9), intent(out) :: possible_digit ! list of possible numbers - integer, intent(out) :: counter_possible_digits ! counter of possible numbers - ! locale variables: - integer :: row,column,cr,lr,j - logical, dimension(0:9) :: possible ! Possibility of each number - - possible = .true. - do j = 1,9 - possible(grid(j,row_0)) = .false. - possible(grid(line_0,j)) = .false. - end do - - lr = 1+3*((line_0-1)/3) - cr = 1+3*((row_0-1)/3) - do row = lr,lr+2 - do column =cr,cr+2 - possible(grid(row,column)) = .false. - end do - end do - - counter_possible_digits = 0 - possible_digit = 0 - do j = 1,9 - if (possible(j)) then - counter_possible_digits = counter_possible_digits+1 - possible_digit(counter_possible_digits) = j - end if - end do - end subroutine - - !**************************************************************** - ! Starting from position p, sort the (still) empty cells by - ! increasing number of allowed numbers to them. This is organized - ! as a bubble sort. - !**************************************************************** - subroutine Draw(empty_cells,p,n) - ! input parameters: - integer,intent(in) :: n ! number of empty lists - integer,intent(in) :: p ! sort, start by position p (p inclusive) - ! output parameters: - integer, dimension(1:81,1:3), intent(inout) :: empty_cells ! list of empty cells - ! local variables: - integer :: i ! loop counters - integer :: j - integer, dimension(1:3) :: column ! save - logical :: completely_solved - - completely_solved = .false. - do while (.not.completely_solved) - completely_solved = .true. - ! let's compare each cell with its succeeding cell - do i = p, n-1 - j = i+1 - if (empty_cells(i,3) > empty_cells(j,3)) then - ! exchange the two cases of this list: - column =empty_cells(i,:) - empty_cells(i,:) = empty_cells(j,:) - empty_cells(j,:) = column - completely_solved = .false. - end if - end do - end do - end subroutine - - - ! Grid generation: in each cycle a number is added and the grid is checked - ! for validity. If the grid became invalid, the grid generation is starts - ! all over again. - ! With a PIII 866 MHz: about 0.5 s. - subroutine CreateFilledGrid(grid) - ! output parameter: - integer, dimension(9, 9), intent(out) :: grid - ! local variables: - real(kind=dp) :: random - integer :: row,column - integer(4) :: tests - logical :: completely_solved - - grid = 0 - - row = 1 - do while(row <= 9) - column =1 - do while(column <= 9) - tests = 0 - completely_solved = .false. - do while(.not.completely_solved) - if (tests > 30) then - ! start from the very beginning - ! (it were impossible to determine how many cycles one - ! has to rewind to identify the erroneous one) - grid = 0 - tests = 0 - column =1 - row = 1 - end if - tests = tests+1 - call Random_number(random) - grid(row,column) = 1+int(random*9_dp) - completely_solved = ValidDigit(grid,row,column) - end do - column =column+1 - end do - row = row+1 - end do - end subroutine CreateFilledGrid - - - logical function ValidDigit(grid,row,column) - ! input: - integer, dimension(9, 9), intent(in) :: grid - integer :: row,column - ! local variables - integer :: i,j - - i = (row-1)/3 - j = (column-1)/3 - - ValidDigit = ValidColumOrRow(grid(row,1:9)).and.ValidColumOrRow(grid(1:9,column)) & - & .and.ValidZone(grid(i*3+1:i*3+3,j*3+1:j*3+3)) - end function ValidDigit - - - ! Note: at present it is unknown if there are Sudoku grids with less than - ! 17 non-zero cells leading to a unique solution. - subroutine CreateSudokuGrid(grid,remainder) - ! output parameter: - integer, dimension(9, 9), intent(inout) :: grid - ! input parameter: - integer,intent(in) :: remainder - ! local variables: - integer, parameter :: n = 10 - integer, dimension(9, 9) :: grid_0 - integer, dimension(1:n, 1:9, 1:9) :: solutions - real(kind=dp) :: random - integer :: row,column,i - logical :: empty,unique - - ! save the initial grid: - grid_0 = grid - - unique = .false. - do while(.not.unique) - grid = grid_0 - - ! remove randomly empty cells - do i = 1, 81-remainder - ! by chance, one picks a of the cells to be removed: - empty = .false. - do while(.not.empty) - call Random_number(random) - row = 1+int(random*9_dp) - call Random_number(random) - column =1+int(random*9_dp) - if (grid(row,column) /= 0) then - empty = .true. - end if - end do - ! erase the previously assigned number in this cell: - grid(row,column) = 0 - end do - - print *,"Search of a grid with unique solution ..." - - ! the grid is solved n times - unique = .true. - i = 1 - sol : do while((i <= n).and.unique) - solutions(i,1:9,1:9) = grid - call Solve_grid(solutions(i,1:9,1:9)) - if (i >= 2) then - do row = 1,9 - do column =1,9 - if (solutions(i,row,column) /= solutions(i-1,row,column)) then - unique = .false. - EXIT sol - end if - end do - end do - end if - i = i+1 - end do sol - - ! With n identical solutions, one likely identified the wanted - ! unique solution. Else, warn the user. - end do - end subroutine CreateSudokuGrid - - - subroutine Save_grid(grid, filename) - integer, dimension(9, 9) :: grid - character(len=*) :: filename - ! local variables - integer :: row,column ! line numbers and column numbers - integer :: fileunit, error - ! file creation: - open(newunit=fileunit, file=filename, STATUS="REPLACE") - - do row = 1, 9 - write(fileunit,'(3i2, " |", 3i2, " |", 3i2)') (grid(row,column) , column=1,9) - if ((row == 3).or.(row == 6)) then - write(fileunit,*) "------+-------+------" - end if - end do - - close(fileunit) - end subroutine Save_grid - - - subroutine Read_grid(grid, filename) - ! output parameter: - integer, dimension(9, 9), intent(out) :: grid - ! input parameter: - character(len=*) :: filename - ! local variables: - character(len=2) :: pipe1,pipe2 ! to read the pipe/the vertical bar - integer :: row ! line - integer :: fileunit, error - logical :: file_exists ! check for the presence of the file requested - - inquire(file = filename, exist = file_exists) - if (file_exists .eqv. .False.) stop "The requested file is absent." - - ! open and read the file, line by line - open(newunit=fileunit, file=filename) - - do row = 1, 9 - READ(fileunit,'(3i2, a2, 3i2, a2, 3i2)') & - grid(row,1:3), pipe1, grid(row,4:6), pipe2, grid(row,7:9) - - ! skip the lines of dashes - if ((row == 3).or.(row == 6)) then - READ(fileunit,*) - end if - end do - - close(fileunit) - end subroutine Read_grid - - - subroutine Display_grid(grid) - integer, dimension(9, 9) :: grid - integer :: row,column ! line numbers and column numbers - - do row = 1, 9 - print '(3i2, " |", 3i2, " |", 3i2)', (grid(row,column) , column=1,9) - if ((row == 3).or.(row == 6)) then - print *, "------+-------+------" - end if - end do - end subroutine Display_grid - - - subroutine Request_grid(grid) - ! input/output: - integer, dimension(9, 9), intent(inout) :: grid - ! local variables: - integer :: row,column ! line numbers and column numbers - - do row = 1, 9 - write (*, "(A, I1, A)") "Enter line ", row, ":" - READ *, (grid(row,column) , column=1,9) - end do - end subroutine Request_grid - - - logical function ValidColumOrRow(col) - ! input parameter: - integer, dimension(1:9) :: col - ! local variables: - integer, dimension(0:9) :: counter ! count the occurrence of each number - integer :: row ! loop counter - - ValidColumOrRow = .true. - counter = 0 - do row = 1,9 - counter(col(row)) = counter(col(row))+1 - if ((counter(col(row)) > 1).and.(col(row) /= 0)) then - ValidColumOrRow = .false. - return ! leave the function - end if - end do - end function ValidColumOrRow - - - logical function ValidZone(region) - ! input: - integer, dimension(1:3, 1:3) :: region - integer, dimension(1:9) :: col - - col(1) = region(1,1) - col(2) = region(1,2) - col(3) = region(1,3) - col(4) = region(2,1) - col(5) = region(2,2) - col(6) = region(2,3) - col(7) = region(3,1) - col(8) = region(3,2) - col(9) = region(3,3) - if (ValidColumOrRow(col)) then - ValidZone = .true. - else - ValidZone = .false. + grid = grid_0 + end if + end do + end subroutine Solve_grid + + ! procedure to create a list of allowed numbers in the present empty cell: + subroutine list_possible_digits(grid, line_0, row_0, & + counter_possible_digits, possible_digit) + ! input parameters: + integer, dimension(9, 9), intent(in) :: grid + integer :: line_0, row_0 + ! output parameters: + integer, dimension(1:9), intent(out) :: possible_digit + integer, intent(out) :: counter_possible_digits + ! locale variables: + integer :: row, column, cr, lr, j + logical, dimension(0:9) :: possible ! Plausibility of each digit + + possible = .true. + do j = 1, 9 + possible(grid(j, row_0)) = .false. + possible(grid(line_0, j)) = .false. + end do + + lr = 1 + 3 * ((line_0 - 1) / 3) + cr = 1 + 3 * ((row_0 - 1) / 3) + do row = lr, lr + 2 + do column = cr, cr + 2 + possible(grid(row, column)) = .false. + end do + end do + + counter_possible_digits = 0 + possible_digit = 0 + do j = 1, 9 + if (possible(j)) then + counter_possible_digits = counter_possible_digits + 1 + possible_digit(counter_possible_digits) = j + end if + end do + end subroutine list_possible_digits + + !**************************************************************** + ! Starting from position p, sort the (still) empty cells by + ! increasing number of allowed numbers to them. This is organized + ! as a bubble sort. + !**************************************************************** + subroutine Draw(empty_cells, p, n) + ! input parameters: + integer, intent(in) :: n ! number of empty lists + integer, intent(in) :: p ! sort, start by position p (p inclusive) + ! output parameters: + integer, dimension(1:81, 1:3), intent(inout) :: empty_cells + ! local variables: + integer :: i, j ! loop counters + integer, dimension(1:3) :: column + logical :: completely_solved + + completely_solved = .false. + do while (.not. completely_solved) + completely_solved = .true. + ! let's compare each cell with its succeeding cell + do i = p, n - 1 + j = i + 1 + if (empty_cells(i, 3) > empty_cells(j, 3)) then + ! exchange the two cases of this list: + column = empty_cells(i, :) + empty_cells(i, :) = empty_cells(j, :) + empty_cells(j, :) = column + completely_solved = .false. end if - end function ValidZone - - - logical function ValidGrid(grid) - ! input: - integer, dimension(9, 9) :: grid - ! local variables: - integer :: row,column - - ValidGrid = .true. - - ! verification of lines: - do row = 1,9 - if (.not.ValidColumOrRow(grid(row,1:9))) then - ValidGrid = .false. - return - !print *, "Line ",row," is not a valid input" - end if + end do + end do + end subroutine + + ! Grid generation: in each cycle a number is added and the grid is checked + ! for validity. If the grid became invalid, the grid generation is starts + ! all over again. + ! With a PIII 866 MHz: about 0.5 s. + subroutine CreateFilledGrid(grid) + ! output parameter: + integer, dimension(9, 9), intent(out) :: grid + ! local variables: + real(kind=dp) :: random + integer :: row, column + integer(4) :: tests + logical :: completely_solved + + grid = 0 + + row = 1 + do while (row <= 9) + column = 1 + do while (column <= 9) + tests = 0 + completely_solved = .false. + do while (.not. completely_solved) + if (tests > 30) then + ! start from the very beginning + ! (it were impossible to determine how many cycles one + ! has to rewind to identify the erroneous one) + grid = 0 + tests = 0 + column = 1 + row = 1 + end if + tests = tests + 1 + call Random_number(random) + grid(row, column) = 1 + int(random * 9_dp) + completely_solved = ValidDigit(grid, row, column) end do + column = column + 1 + end do + row = row + 1 + end do + end subroutine CreateFilledGrid - ! verification of columns: - do column =1,9 - if (.not.ValidColumOrRow(grid(1:9,column))) then - ValidGrid = .false. - return - !print *, "Column ",column," is not a valid input" - end if + logical function ValidDigit(grid, row, column) + ! input: + integer, dimension(9, 9), intent(in) :: grid + integer :: row, column + ! local variables + integer :: i, j + + i = (row - 1) / 3 + j = (column - 1) / 3 + + ValidDigit = ValidColumOrRow(grid(row, 1:9)) .and. & + ValidColumOrRow(grid(1:9, column)) .and. & + ValidZone(grid(i * 3 + 1:i * 3 + 3, j * 3 + 1:j * 3 + 3)) + end function ValidDigit + + ! Note: at present it is unknown if there are Sudoku grids with less than + ! 17 non-zero cells leading to a unique solution. + subroutine CreateSudokuGrid(grid, remainder) + ! output parameter: + integer, dimension(9, 9), intent(inout) :: grid + ! input parameter: + integer, intent(in) :: remainder + ! local variables: + integer, parameter :: n = 10 + integer, dimension(9, 9) :: grid_0 + integer, dimension(1:n, 1:9, 1:9) :: solutions + real(kind=dp) :: random + integer :: row, column, i + logical :: empty, unique + + ! save the initial grid: + grid_0 = grid + + unique = .false. + do while (.not. unique) + grid = grid_0 + + ! remove randomly empty cells + do i = 1, 81 - remainder + ! by chance, one picks a of the cells to be removed: + empty = .false. + do while (.not. empty) + call Random_number(random) + row = 1 + int(random * 9_dp) + call Random_number(random) + column = 1 + int(random * 9_dp) + if (grid(row, column) /= 0) then + empty = .true. + end if end do - - ! verification of regions: - do row = 1,7,+3 - do column =1,7,+3 - if (.not.ValidZone(grid(row:row+2,column:column+2))) then - ValidGrid = .false. - return - !print *, "Region ",row,column," is not a valid input" - end if + ! erase the previously assigned number in this cell: + grid(row, column) = 0 + end do + + print *, "Search of a grid with unique solution ..." + + ! the grid is solved n times + unique = .true. + i = 1 + sol: do while ((i <= n) .and. unique) + solutions(i, 1:9, 1:9) = grid + call Solve_grid(solutions(i, 1:9, 1:9)) + if (i >= 2) then + do row = 1, 9 + do column = 1, 9 + if (solutions(i, row, column) /= solutions(i - 1, row, column)) then + unique = .false. + EXIT sol + end if end do - end do - end function ValidGrid - - !************************************************************ - ! initialization of a system independent pseudorandom generator - !************************************************************ - subroutine Initialize_Random - integer(4), dimension(1:8) :: timeValues - integer(4), allocatable, dimension (:) :: random_seede - - integer(4) :: loop , n - - call date_and_time(VALUES = timeValues) - - ! retrieve the integers to store a seed: !? On récupère le nombre d'entiers servant à stocker la random_seede : - call random_seed(SIZE = n) - allocate(random_seede(1:n)) - - ! use thousandths of a second by the clock: - do loop = 1 , n - random_seede(loop) = huge(random_seede(loop))/1000*timeValues(8) - end do - - ! hand over the seed: - call random_seed(put = random_seede(1:n)) - end subroutine Initialize_Random - + end do + end if + i = i + 1 + end do sol + + ! With n identical solutions, one likely identified the wanted + ! unique solution. Else, warn the user. + end do + end subroutine CreateSudokuGrid + + subroutine Save_grid(grid, filename) + integer, dimension(9, 9) :: grid + character(len=*) :: filename + ! local variables + integer :: row, column ! line numbers and column numbers + integer :: fileunit, error + ! file creation: + open (newunit=fileunit, file=filename, STATUS="REPLACE") + + do row = 1, 9 + write (fileunit, '(3I2, " |", 3I2, " |", 3I2)') (grid(row, column), column=1, 9) + if ((row == 3) .or. (row == 6)) then + write (fileunit, *) "------+-------+------" + end if + end do + + close (fileunit) + end subroutine Save_grid + + subroutine Read_grid(grid, filename) + ! output parameter: + integer, dimension(9, 9), intent(out) :: grid + ! input parameter: + character(len=*) :: filename + ! local variables: + character(len=2) :: pipe1, pipe2 ! to read the pipe/the vertical bar + integer :: row ! line + integer :: fileunit, error + logical :: file_exists ! check for the presence of the file requested + + inquire (file=filename, exist=file_exists) + if (file_exists .eqv. .False.) stop "The requested file is absent." + + ! open and read the file, line by line + open (newunit=fileunit, file=filename) + + do row = 1, 9 + READ (fileunit, '(3I2, A2, 3I2, A2, 3I2)') & + grid(row, 1:3), pipe1, grid(row, 4:6), pipe2, grid(row, 7:9) + + ! skip the lines of dashes + if ((row == 3) .or. (row == 6)) then + READ (fileunit, *) + end if + end do + + close (fileunit) + end subroutine Read_grid + + subroutine Display_grid(grid) + integer, dimension(9, 9) :: grid + integer :: row, column ! line numbers and column numbers + + do row = 1, 9 + print '(3I2, " |", 3I2, " |", 3I2)', (grid(row, column), column=1, 9) + if ((row == 3) .or. (row == 6)) then + print *, "------+-------+------" + end if + end do + end subroutine Display_grid + + subroutine Request_grid(grid) + ! input/output: + integer, dimension(9, 9), intent(inout) :: grid + ! local variables: + integer :: row, column ! line numbers and column numbers - !*********************************************************** - ! return the CPU time (expressed in seconds) - ! cpu_time() is defined by standards of Fortran 95, and later. - !*********************************************************** - real(kind=dp) function Time() - Real(kind=dp) :: t + do row = 1, 9 + write (*, "(A, I1, A)") "Enter line ", row, ":" + READ *, (grid(row, column), column=1, 9) + end do + end subroutine Request_grid - call cpu_time(t) - Time = t - end function Time + logical function ValidColumOrRow(col) + ! input parameter: + integer, dimension(1:9) :: col + ! local variables: + integer, dimension(0:9) :: counter ! count the occurrence of each number + integer :: row + + ValidColumOrRow = .true. + counter = 0 + do row = 1, 9 + counter(col(row)) = counter(col(row)) + 1 + if ((counter(col(row)) > 1) .and. (col(row) /= 0)) then + ValidColumOrRow = .false. + return ! leave the function + end if + end do + end function ValidColumOrRow + + logical function ValidZone(region) + ! input: + integer, dimension(1:3, 1:3) :: region + integer, dimension(1:9) :: col + + col(1) = region(1, 1) + col(2) = region(1, 2) + col(3) = region(1, 3) + col(4) = region(2, 1) + col(5) = region(2, 2) + col(6) = region(2, 3) + col(7) = region(3, 1) + col(8) = region(3, 2) + col(9) = region(3, 3) + if (ValidColumOrRow(col)) then + ValidZone = .true. + else + ValidZone = .false. + end if + end function ValidZone - subroutine solver(grid, file) + logical function ValidGrid(grid) + ! input: + integer, dimension(9, 9) :: grid + ! local variables: + integer :: row, column + + ValidGrid = .true. + + ! verification of lines: + do row = 1, 9 + if (.not. ValidColumOrRow(grid(row, 1:9))) then + ValidGrid = .false. + return + !print *, "Line ",row," is not a valid input" + end if + end do + + ! verification of columns: + do column = 1, 9 + if (.not. ValidColumOrRow(grid(1:9, column))) then + ValidGrid = .false. + return + !print *, "Column ",column," is not a valid input" + end if + end do + + ! verification of regions: + do row = 1, 7, +3 + do column = 1, 7, +3 + if (.not. ValidZone(grid(row:row + 2, column:column + 2))) then + ValidGrid = .false. + return + !print *, "Region ",row,column," is not a valid input" + end if + end do + end do + end function ValidGrid + + !************************************************************ + ! initialization of a system independent pseudorandom generator + !************************************************************ + subroutine Initialize_Random + integer(4), dimension(1:8) :: timeValues + integer(4), allocatable, dimension(:) :: random_seede + + integer(4) :: loop, n + + call date_and_time(VALUES=timeValues) + + ! retrieve the integers to store a seed: !? On récupère le nombre d'entiers servant à stocker la random_seede : + call random_seed(SIZE=n) + allocate (random_seede(1:n)) + + ! use thousandths of a second by the clock: + do loop = 1, n + random_seede(loop) = huge(random_seede(loop)) / 1000 * timeValues(8) + end do + + ! hand over the seed: + call random_seed(put=random_seede(1:n)) + end subroutine Initialize_Random + + !*********************************************************** + ! return the CPU time (expressed in seconds) + ! cpu_time() is defined by standards of Fortran 95, and later. + !*********************************************************** + real(kind=dp) function Time() + Real(kind=dp) :: t + + call cpu_time(t) + Time = t + end function Time + + subroutine solver(grid, file) ! ****************************************************************** - ! proempty a solution for a partially filled grid proemptyd as a file + ! provide a solution for a partially filled grid entered as a file ! ! Concept study for a direct invocation of the executable by the CLI ! as, for example, by @@ -503,25 +495,25 @@ subroutine solver(grid, file) ! ! ****************************************************************** ! input: - character(len = 50), intent(in) :: file + character(len=50), intent(in) :: file integer, dimension(9, 9), intent(inout) :: grid ! local variables: logical :: presence presence = .False. - inquire(file = file, exist = presence) - if (presence .eqv. .False.) then - print *, "The requested file '", trim(file), "' is inaccessible." - end if + inquire (file=file, exist=presence) + if (presence .eqv. .False.) then + print *, "The requested file '", trim(file), "' is inaccessible." + end if call Read_grid(grid, file) if (ValidGrid(grid) .eqv. .True.) then - call Solve_grid(grid) - call Display_grid(grid) + call Solve_grid(grid) + call Display_grid(grid) else - print *, "The input by file'", trim(file), "' is an invalid grid." + print *, "The input by file'", trim(file), "' is an invalid grid." end if - end subroutine solver + end subroutine solver end module sudoku diff --git a/test/check.f90 b/test/check.f90 index 84e826b..261768c 100644 --- a/test/check.f90 +++ b/test/check.f90 @@ -1,161 +1,166 @@ ! file: check.f90 ! date: [2023-08-24 Thu] -! edit: [2023-09-05 Tue] +! edit: [2023-09-12 Tue] ! This file contains tests to be launched by `fpm test`. program check - use sudoku, only: Read_grid, Solve_grid - implicit none + use sudoku, only: Read_grid, Solve_grid + implicit none - call assert_readtest01() - call assert_readtest02() - call assert_wikipedia_solution() + call assert_readtest01() + call assert_readtest02() + call assert_wikipedia_solution() contains - subroutine assert_readtest01() - ! read an incomplete Sudoku grid with implicitly empty cases - integer :: reference_grid(9,9), grid_from_file(9,9) - integer :: i, j - logical :: array_equality - - array_equality = .true. - - reference_grid(:, 1) = [5, 3, 0, 0, 7, 0, 0, 0, 0] - reference_grid(:, 2) = [6, 0, 0, 1, 9, 5, 0, 0, 0] - reference_grid(:, 3) = [0, 9, 8, 0, 0, 0, 0, 6, 0] - - reference_grid(:, 4) = [8, 0, 0, 0, 6, 0, 0, 0, 3] - reference_grid(:, 5) = [4, 0, 0, 8, 0, 3, 0, 0, 1] - reference_grid(:, 6) = [7, 0, 0, 0, 2, 0, 0, 0, 6] - - reference_grid(:, 7) = [0, 6, 0, 0, 0, 0, 2, 8, 0] - reference_grid(:, 8) = [0, 0, 0, 4, 1, 9, 0, 0, 5] - reference_grid(:, 9) = [0, 0, 0, 0, 8, 0, 0, 7, 9] - - call Read_grid(grid_from_file, "./test/test_in_01.txt") - grid_from_file = transpose(grid_from_file) - - outer: do i = 1, 9 - ! write (*, "(9I3)") grid_from_file(:,i) - inner: do j = 1, 9 - if (reference_grid(i, j) /= grid_from_file(i, j)) then - array_equality = .false. - print *, "At i : ", i, "j : ", j, & - "reference_grid : ", reference_grid(i,j), & - "differs from grid_from_file :", grid_from_file(i,j) - exit outer - end if - end do inner - end do outer - - if (array_equality .eqv. .false.) then - print *, "Reading check on `test_in_01.txt` failed." - else - print *, "Reading check on `test_in_01.txt` was successful." - end if - end subroutine assert_readtest01 - - - subroutine assert_readtest02() - ! read an incomplete Sudoku grid with explicitly empty cases - integer :: reference_grid(9,9), grid_from_file(9,9) - integer :: i, j - logical :: array_equality - - array_equality = .true. - - reference_grid(:, 1) = [5, 3, 0, 0, 7, 0, 0, 0, 0] - reference_grid(:, 2) = [6, 0, 0, 1, 9, 5, 0, 0, 0] - reference_grid(:, 3) = [0, 9, 8, 0, 0, 0, 0, 6, 0] - - reference_grid(:, 4) = [8, 0, 0, 0, 6, 0, 0, 0, 3] - reference_grid(:, 5) = [4, 0, 0, 8, 0, 3, 0, 0, 1] - reference_grid(:, 6) = [7, 0, 0, 0, 2, 0, 0, 0, 6] - - reference_grid(:, 7) = [0, 6, 0, 0, 0, 0, 2, 8, 0] - reference_grid(:, 8) = [0, 0, 0, 4, 1, 9, 0, 0, 5] - reference_grid(:, 9) = [0, 0, 0, 0, 8, 0, 0, 7, 9] - - call Read_grid(grid_from_file, "./test/test_in_02.txt") - grid_from_file = transpose(grid_from_file) - - outer: do i = 1, 9 - ! write (*, "(9I3)") grid_from_file(:,i) - inner: do j = 1, 9 - if (reference_grid(i, j) /= grid_from_file(i, j)) then - array_equality = .false. - print *, "At i : ", i, "j : ", j, & - "reference_grid : ", reference_grid(i,j), & - "differs from grid_from_file :", grid_from_file(i,j) - exit outer - end if - end do inner - end do outer - - - if (array_equality .eqv. .false.) then - print *, "Reading check on `test_in_02.txt` failed." - else - print *, "Reading check on `test_in_02.txt` was successful." - end if - end subroutine assert_readtest02 - - - subroutine assert_wikipedia_solution() - ! see the reference grids on https://en.wikipedia.org/wiki/Sudoku - ! local variables: - integer :: grid_a(9,9), grid_b(9,9) - integer :: i, j - logical :: array_equality - - array_equality = .true. - - ! Wikipedia's incomplete Sudoku grid - grid_a(:, 1) = [5, 3, 0, 0, 7, 0, 0, 0, 0] - grid_a(:, 2) = [6, 0, 0, 1, 9, 5, 0, 0, 0] - grid_a(:, 3) = [0, 9, 8, 0, 0, 0, 0, 6, 0] - - grid_a(:, 4) = [8, 0, 0, 0, 6, 0, 0, 0, 3] - grid_a(:, 5) = [4, 0, 0, 8, 0, 3, 0, 0, 1] - grid_a(:, 6) = [7, 0, 0, 0, 2, 0, 0, 0, 6] - - grid_a(:, 7) = [0, 6, 0, 0, 0, 0, 2, 8, 0] - grid_a(:, 8) = [0, 0, 0, 4, 1, 9, 0, 0, 5] - grid_a(:, 9) = [0, 0, 0, 0, 8, 0, 0, 7, 9] - - call Solve_grid(grid_a) ! this fills (hence modifies) grid_a - - ! Wikipedia's complete Sudoku grid - grid_b(:, 1) = [5, 3, 4, 6, 7, 8, 9, 1, 2] - grid_b(:, 2) = [6, 7, 2, 1, 9, 5, 3, 4, 8] - grid_b(:, 3) = [1, 9, 8, 3, 4, 2, 5, 6, 7] - - grid_b(:, 4) = [8, 5, 9, 7, 6, 1, 4, 2, 3] - grid_b(:, 5) = [4, 2, 6, 8, 5, 3, 7, 9, 1] - grid_b(:, 6) = [7, 1, 3, 9, 2, 4, 8, 5, 6] - - grid_b(:, 7) = [9, 6, 1, 5, 3, 7, 2, 8, 4] - grid_b(:, 8) = [2, 8, 7, 4, 1, 9, 6, 3, 5] - grid_b(:, 9) = [3, 4, 5, 2, 8, 6, 1, 7, 9] - - ! comparison of computed solution with Wikipedia's reference solution - outer: do i = 1, 9 - do j = 1, 9 - if (grid_a(i, j) /= grid_b(i, j)) then - array_equality = .false. - print *, "At i : ", i, "j : ", j, "grid_a : ", grid_a(i,j), & - "the solution differs from expected value of grid_b :", grid_b(i,j) - exit outer - end if - end do - end do outer - - if (array_equality .eqv. .false.) then - print *, "The Wikipedia array assertion failed." - else - print *, "The Wikipedia array assertion was successful." - end if - end subroutine assert_wikipedia_solution + subroutine assert_readtest01() + ! read an incomplete Sudoku grid with implicitly empty cases + integer :: reference_grid(9, 9), grid_from_file(9, 9) + integer :: i, j + logical :: array_equality + + array_equality = .true. + + !&< + reference_grid(:, 1) = [5, 3, 0, 0, 7, 0, 0, 0, 0] + reference_grid(:, 2) = [6, 0, 0, 1, 9, 5, 0, 0, 0] + reference_grid(:, 3) = [0, 9, 8, 0, 0, 0, 0, 6, 0] + + reference_grid(:, 4) = [8, 0, 0, 0, 6, 0, 0, 0, 3] + reference_grid(:, 5) = [4, 0, 0, 8, 0, 3, 0, 0, 1] + reference_grid(:, 6) = [7, 0, 0, 0, 2, 0, 0, 0, 6] + + reference_grid(:, 7) = [0, 6, 0, 0, 0, 0, 2, 8, 0] + reference_grid(:, 8) = [0, 0, 0, 4, 1, 9, 0, 0, 5] + reference_grid(:, 9) = [0, 0, 0, 0, 8, 0, 0, 7, 9] + !&> + + call Read_grid(grid_from_file, "./test/test_in_01.txt") + grid_from_file = transpose(grid_from_file) + + outer: do i = 1, 9 + ! write (*, "(9I3)") grid_from_file(:,i) + inner: do j = 1, 9 + if (reference_grid(i, j) /= grid_from_file(i, j)) then + array_equality = .false. + print *, "At i : ", i, "j : ", j, & + "reference_grid : ", reference_grid(i, j), & + "differs from grid_from_file :", grid_from_file(i, j) + exit outer + end if + end do inner + end do outer + + if (array_equality .eqv. .false.) then + print *, "Reading check on `test_in_01.txt` failed." + else + print *, "Reading check on `test_in_01.txt` was successful." + end if + end subroutine assert_readtest01 + + subroutine assert_readtest02() + ! read an incomplete Sudoku grid with explicitly empty cases + integer :: reference_grid(9, 9), grid_from_file(9, 9) + integer :: i, j + logical :: array_equality + + array_equality = .true. + + !&< + reference_grid(:, 1) = [5, 3, 0, 0, 7, 0, 0, 0, 0] + reference_grid(:, 2) = [6, 0, 0, 1, 9, 5, 0, 0, 0] + reference_grid(:, 3) = [0, 9, 8, 0, 0, 0, 0, 6, 0] + + reference_grid(:, 4) = [8, 0, 0, 0, 6, 0, 0, 0, 3] + reference_grid(:, 5) = [4, 0, 0, 8, 0, 3, 0, 0, 1] + reference_grid(:, 6) = [7, 0, 0, 0, 2, 0, 0, 0, 6] + + reference_grid(:, 7) = [0, 6, 0, 0, 0, 0, 2, 8, 0] + reference_grid(:, 8) = [0, 0, 0, 4, 1, 9, 0, 0, 5] + reference_grid(:, 9) = [0, 0, 0, 0, 8, 0, 0, 7, 9] + !&> + + call Read_grid(grid_from_file, "./test/test_in_02.txt") + grid_from_file = transpose(grid_from_file) + + outer: do i = 1, 9 + ! write (*, "(9I3)") grid_from_file(:,i) + inner: do j = 1, 9 + if (reference_grid(i, j) /= grid_from_file(i, j)) then + array_equality = .false. + print *, "At i : ", i, "j : ", j, & + "reference_grid : ", reference_grid(i, j), & + "differs from grid_from_file :", grid_from_file(i, j) + exit outer + end if + end do inner + end do outer + + if (array_equality .eqv. .false.) then + print *, "Reading check on `test_in_02.txt` failed." + else + print *, "Reading check on `test_in_02.txt` was successful." + end if + end subroutine assert_readtest02 + + subroutine assert_wikipedia_solution() + ! see the reference grids on https://en.wikipedia.org/wiki/Sudoku + ! local variables: + integer :: grid_a(9, 9), grid_b(9, 9) + integer :: i, j + logical :: array_equality + + array_equality = .true. + + ! Wikipedia's incomplete Sudoku grid + !&< + grid_a(:, 1) = [5, 3, 0, 0, 7, 0, 0, 0, 0] + grid_a(:, 2) = [6, 0, 0, 1, 9, 5, 0, 0, 0] + grid_a(:, 3) = [0, 9, 8, 0, 0, 0, 0, 6, 0] + + grid_a(:, 4) = [8, 0, 0, 0, 6, 0, 0, 0, 3] + grid_a(:, 5) = [4, 0, 0, 8, 0, 3, 0, 0, 1] + grid_a(:, 6) = [7, 0, 0, 0, 2, 0, 0, 0, 6] + + grid_a(:, 7) = [0, 6, 0, 0, 0, 0, 2, 8, 0] + grid_a(:, 8) = [0, 0, 0, 4, 1, 9, 0, 0, 5] + grid_a(:, 9) = [0, 0, 0, 0, 8, 0, 0, 7, 9] + !&> + + call Solve_grid(grid_a) ! this fills (hence modifies) grid_a + + ! Wikipedia's complete Sudoku grid + !&< + grid_b(:, 1) = [5, 3, 4, 6, 7, 8, 9, 1, 2] + grid_b(:, 2) = [6, 7, 2, 1, 9, 5, 3, 4, 8] + grid_b(:, 3) = [1, 9, 8, 3, 4, 2, 5, 6, 7] + + grid_b(:, 4) = [8, 5, 9, 7, 6, 1, 4, 2, 3] + grid_b(:, 5) = [4, 2, 6, 8, 5, 3, 7, 9, 1] + grid_b(:, 6) = [7, 1, 3, 9, 2, 4, 8, 5, 6] + + grid_b(:, 7) = [9, 6, 1, 5, 3, 7, 2, 8, 4] + grid_b(:, 8) = [2, 8, 7, 4, 1, 9, 6, 3, 5] + grid_b(:, 9) = [3, 4, 5, 2, 8, 6, 1, 7, 9] + !&> + + ! comparison of computed solution with Wikipedia's reference solution + outer: do i = 1, 9 + do j = 1, 9 + if (grid_a(i, j) /= grid_b(i, j)) then + array_equality = .false. + print *, "At i : ", i, "j : ", j, "grid_a : ", grid_a(i, j), & + "the solution differs from expected value of grid_b :", grid_b(i, j) + exit outer + end if + end do + end do outer + + if (array_equality .eqv. .false.) then + print *, "The Wikipedia array assertion failed." + else + print *, "The Wikipedia array assertion was successful." + end if + end subroutine assert_wikipedia_solution end program check