RosettaCodeData/Task/Solve-a-Numbrix-puzzle/FreeBASIC/solve-a-numbrix-puzzle.basic
2024-10-16 18:07:41 -07:00

120 lines
3.5 KiB
Text

Type Move
dx As Integer
dy As Integer
End Type
Dim Shared As Move moves(3) = {(0, 1), (1, 0), (0, -1), (-1, 0)}
Dim Shared As Integer grid(10, 10)
Dim Shared As Integer clues(99)
Dim Shared As Integer clueCount, totalToFill
Dim Shared As String example1(8)
example1(0) = "00,00,00,00,00,00,00,00,00"
example1(1) = "00,00,46,45,00,55,74,00,00"
example1(2) = "00,38,00,00,43,00,00,78,00"
example1(3) = "00,35,00,00,00,00,00,71,00"
example1(4) = "00,00,33,00,00,00,59,00,00"
example1(5) = "00,17,00,00,00,00,00,67,00"
example1(6) = "00,18,00,00,11,00,00,64,00"
example1(7) = "00,00,24,21,00,01,02,00,00"
example1(8) = "00,00,00,00,00,00,00,00,00"
Dim Shared As String example2(8)
example2(0) = "00,00,00,00,00,00,00,00,00"
example2(1) = "00,11,12,15,18,21,62,61,00"
example2(2) = "00,06,00,00,00,00,00,60,00"
example2(3) = "00,33,00,00,00,00,00,57,00"
example2(4) = "00,32,00,00,00,00,00,56,00"
example2(5) = "00,37,00,01,00,00,00,73,00"
example2(6) = "00,38,00,00,00,00,00,72,00"
example2(7) = "00,43,44,47,48,51,76,77,00"
example2(8) = "00,00,00,00,00,00,00,00,00"
Sub SortArray(arr() As Integer, n As Integer)
Dim As Integer i, j
For i = 0 To n - 2
For j = 0 To n - 2 - i
If arr(j) > arr(j + 1) Then Swap arr(j), arr(j + 1)
Next j
Next i
End Sub
Function solve(r As Integer, c As Integer, count As Integer, nextClue As Integer) As Boolean
If count > totalToFill Then Return True
Dim As Integer back = grid(r, c)
If back <> 0 Andalso back <> count Then Return False
If back = 0 Andalso nextClue < clueCount Andalso clues(nextClue) = count Then Return False
If back = count Then nextClue += 1
grid(r, c) = count
For i As Integer = 0 To 3
If solve(r + moves(i).dy, c + moves(i).dx, count + 1, nextClue) Then Return True
Next i
grid(r, c) = back
Return False
End Function
Sub printSolution(n As Integer)
Print "Solution for example " & n & !":\n"
For r As Integer = 1 To 9
For c As Integer = 1 To 9
If grid(r, c) = -1 Then Continue For
Print Using "## "; grid(r, c);
Next c
Print
Next r
Print
End Sub
Sub main()
Dim As Integer n, i, r, c
Dim As String board(8)
For n = 0 To 1
If n = 0 Then
For i = 0 To 8: board(i) = example1(i): Next
Else
For i = 0 To 8: board(i) = example2(i): Next
End If
Dim As Integer nRows = Ubound(board) + 3
Dim As Integer nCols = 11
Dim As Integer startRow = 0, startCol = 0
totalToFill = (nRows - 2) * (nCols - 2)
clueCount = 0
For r = 0 To nRows - 1
For c = 0 To nCols - 1
grid(r, c) = -1
Next c
If r >= 1 Andalso r < nRows - 1 Then
Dim As String row = board(r - 1)
Dim As Integer posic = 1
For c = 1 To nCols - 2
Dim As String cell = Mid(row, posic, 2)
posic += 3
Dim As Integer valor = Cint(cell)
If valor > 0 Then
clues(clueCount) = valor
clueCount += 1
End If
If valor = 1 Then
startRow = r
startCol = c
End If
grid(r, c) = valor
Next c
End If
Next r
SortArray(clues(), clueCount)
If solve(startRow, startCol, 1, 0) Then printSolution(n + 1)
Next n
End Sub
main()
Sleep