202 lines
6.3 KiB
Text
202 lines
6.3 KiB
Text
Const NROWS = 7
|
|
Const NCOLS = 8
|
|
Const MAXDOMINOS = 28
|
|
Const MAXSOLUTIONS = 10000
|
|
|
|
Type Domino
|
|
a As Integer
|
|
b As Integer
|
|
End Type
|
|
|
|
Type Move
|
|
r1 As Integer
|
|
c1 As Integer
|
|
r2 As Integer
|
|
c2 As Integer
|
|
End Type
|
|
|
|
Type Solution
|
|
moves(0 To MAXDOMINOS-1) As Move
|
|
End Type
|
|
|
|
' Initialize tabla data
|
|
Dim Shared As Integer tableau1(NROWS-1, NCOLS-1) = { _
|
|
{0, 5, 1, 3, 2, 2, 3, 1}, _
|
|
{0, 5, 5, 0, 5, 2, 4, 6}, _
|
|
{4, 3, 0, 3, 6, 6, 2, 0}, _
|
|
{0, 6, 2, 3, 5, 1, 2, 6}, _
|
|
{1, 1, 3, 0, 0, 2, 4, 5}, _
|
|
{2, 1, 4, 3, 3, 4, 6, 6}, _
|
|
{6, 4, 5, 1, 5, 4, 1, 4} }
|
|
|
|
Dim Shared As Integer tableau2(NROWS-1, NCOLS-1) = { _
|
|
{6, 4, 2, 2, 0, 6, 5, 0}, _
|
|
{1, 6, 2, 3, 4, 1, 4, 3}, _
|
|
{2, 1, 0, 2, 3, 5, 5, 1}, _
|
|
{1, 3, 5, 0, 5, 6, 1, 0}, _
|
|
{4, 2, 6, 0, 4, 0, 1, 1}, _
|
|
{4, 4, 2, 0, 5, 3, 6, 3}, _
|
|
{6, 6, 5, 2, 5, 3, 3, 4} }
|
|
|
|
Function makeDomino(a As Integer, b As Integer) As Domino
|
|
If a < b Then Return Type<Domino>(a, b) Else Return Type<Domino>(b, a)
|
|
End Function
|
|
|
|
Function dominoUsed(d As Domino, used() As Domino, count As Integer) As Boolean
|
|
For i As Integer = 0 To count-1
|
|
If used(i).a = d.a And used(i).b = d.b Then Return True
|
|
Next
|
|
Return False
|
|
End Function
|
|
|
|
Sub findFirstEmpty(grid() As Integer, Byref row As Integer, Byref col As Integer)
|
|
For i As Integer = 0 To NROWS-1
|
|
For j As Integer = 0 To NCOLS-1
|
|
If grid(i*NCOLS+j) = -1 Then
|
|
row = i : col = j : Exit Sub
|
|
End If
|
|
Next
|
|
Next
|
|
row = -1 : col = -1
|
|
End Sub
|
|
|
|
Sub printDominoLayout(moves() As Move, tableau() As Integer)
|
|
Dim As Integer i, j, k
|
|
Dim As String cell(NROWS-1, NCOLS-1), vplus(NROWS-2, NCOLS-1)
|
|
|
|
For i = 0 To NROWS-1
|
|
For j = 0 To NCOLS-1
|
|
cell(i, j) = Str(tableau(i, j))
|
|
Next
|
|
Next
|
|
For i = 0 To NROWS-2
|
|
For j = 0 To NCOLS-1
|
|
vplus(i, j) = " "
|
|
Next
|
|
Next
|
|
For k = 0 To MAXDOMINOS-1
|
|
Dim m As Move = moves(k)
|
|
If m.r1 = -1 Then Exit For
|
|
If m.r1 = m.r2 Then
|
|
cell(m.r1, m.c1) = cell(m.r1, m.c1) + "+" + cell(m.r2, m.c2)
|
|
cell(m.r2, m.c2) = ""
|
|
Else
|
|
vplus(m.r1, m.c1) = "+"
|
|
End If
|
|
Next
|
|
|
|
' Calculate the width of each cell (maximum 3: "a+b")
|
|
Dim As Integer anchoCelda = 3
|
|
|
|
For i = 0 To NROWS-1
|
|
Dim As String linea = ""
|
|
For j = 0 To NCOLS-1
|
|
Dim As String s = Iif(cell(i, j) <> "", cell(i, j), "")
|
|
' Pad right for fixed width
|
|
linea &= Left(s + Space(anchoCelda), anchoCelda)
|
|
If j < NCOLS-1 Then linea &= " "
|
|
Next
|
|
linea = Rtrim(linea)
|
|
Print linea
|
|
|
|
If i < NROWS-1 Then
|
|
Dim As String vline = ""
|
|
For j = 0 To NCOLS-1
|
|
vline &= vplus(i, j)
|
|
' Pad right for fixed width
|
|
vline &= Space(anchoCelda - 1)
|
|
If j < NCOLS-1 Then vline &= " "
|
|
Next
|
|
vline = Rtrim(vline)
|
|
Print vline
|
|
End If
|
|
Next
|
|
Print
|
|
End Sub
|
|
|
|
Sub solveRec(tableau() As Integer, grid() As Integer, used() As Domino, usedCount As Integer, moves() As Move, moveCount As Integer, solutions() As Solution, Byref num_solutions As Integer)
|
|
Dim As Integer row, col
|
|
findFirstEmpty grid(), row, col
|
|
If row = -1 Then
|
|
If num_solutions < MAXSOLUTIONS Then
|
|
For i As Integer = 0 To MAXDOMINOS-1
|
|
If i < moveCount Then
|
|
solutions(num_solutions).moves(i) = moves(i)
|
|
Else
|
|
solutions(num_solutions).moves(i).r1 = -1
|
|
End If
|
|
Next
|
|
num_solutions += 1
|
|
End If
|
|
Exit Sub
|
|
End If
|
|
|
|
' Horizontal
|
|
If col < NCOLS-1 Then
|
|
If grid(row*NCOLS+col+1) = -1 Then
|
|
Dim d As Domino = makeDomino(tableau(row, col), tableau(row, col+1))
|
|
If dominoUsed(d, used(), usedCount) = 0 Then
|
|
grid(row*NCOLS+col) = tableau(row, col)
|
|
grid(row*NCOLS+col+1) = tableau(row, col+1)
|
|
used(usedCount) = d
|
|
moves(moveCount).r1 = row : moves(moveCount).c1 = col
|
|
moves(moveCount).r2 = row : moves(moveCount).c2 = col+1
|
|
solveRec tableau(), grid(), used(), usedCount+1, moves(), moveCount+1, solutions(), num_solutions
|
|
grid(row*NCOLS+col) = -1
|
|
grid(row*NCOLS+col+1) = -1
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
' Vertical
|
|
If row < NROWS-1 Then
|
|
If grid((row+1)*NCOLS+col) = -1 Then
|
|
Dim d As Domino = makeDomino(tableau(row, col), tableau(row+1, col))
|
|
If dominoUsed(d, used(), usedCount) = 0 Then
|
|
grid(row*NCOLS+col) = tableau(row, col)
|
|
grid((row+1)*NCOLS+col) = tableau(row+1, col)
|
|
used(usedCount) = d
|
|
moves(moveCount).r1 = row : moves(moveCount).c1 = col
|
|
moves(moveCount).r2 = row+1 : moves(moveCount).c2 = col
|
|
solveRec tableau(), grid(), used(), usedCount+1, moves(), moveCount+1, solutions(), num_solutions
|
|
grid(row*NCOLS+col) = -1
|
|
grid((row+1)*NCOLS+col) = -1
|
|
End If
|
|
End If
|
|
End If
|
|
End Sub
|
|
|
|
Sub solve(tableau() As Integer, solutions() As Solution, Byref num_solutions As Integer)
|
|
Dim As Integer grid(NROWS*NCOLS-1)
|
|
For i As Integer = 0 To NROWS*NCOLS-1
|
|
grid(i) = -1
|
|
Next
|
|
Dim As Domino used(MAXDOMINOS-1)
|
|
Dim As Move moves(MAXDOMINOS-1)
|
|
num_solutions = 0
|
|
solveRec tableau(), grid(), used(), 0, moves(), 0, solutions(), num_solutions
|
|
End Sub
|
|
|
|
' Main progranm
|
|
Dim Shared As Solution solutions1(0 To MAXSOLUTIONS-1)
|
|
Dim As Integer num_solutions1
|
|
Dim Shared As Solution solutions2(0 To MAXSOLUTIONS-1)
|
|
Dim As Integer num_solutions2
|
|
|
|
Dim As Double t1 = Timer
|
|
solve(tableau1(), solutions1(), num_solutions1)
|
|
Dim As Double t2 = Timer
|
|
solve(tableau2(), solutions2(), num_solutions2)
|
|
Dim As Double t3 = Timer
|
|
|
|
If num_solutions1 > 0 Then printDominoLayout(solutions1(0).moves(), tableau1())
|
|
Print num_solutions1; " layouts found."; Iif(num_solutions1 > 1, " (first one shown)", "")
|
|
Print Using "Took #.##### seconds."; t2-t1
|
|
Print
|
|
|
|
If num_solutions2 > 0 Then printDominoLayout(solutions2(0).moves(), tableau2())
|
|
Print num_solutions2; " layouts found."; Iif(num_solutions2 > 1, " (first one shown)", "")
|
|
Print Using "Took #.##### seconds."; t3-t2
|
|
Print
|
|
|
|
Sleep
|