59 lines
1.8 KiB
VB.net
59 lines
1.8 KiB
VB.net
'N-queens problem - non recursive & structured - vb6 - 25/02/2017
|
|
Sub n_queens()
|
|
Const l = 15 'number of queens
|
|
Const b = False 'print option
|
|
Dim a(l), s(l), u(4 * l - 2)
|
|
Dim n, m, i, j, p, q, r, k, t, z
|
|
For i = 1 To UBound(a): a(i) = i: Next i
|
|
For n = 1 To l
|
|
m = 0
|
|
i = 1
|
|
j = 0
|
|
r = 2 * n - 1
|
|
Do
|
|
i = i - 1
|
|
j = j + 1
|
|
p = 0
|
|
q = -r
|
|
Do
|
|
i = i + 1
|
|
u(p) = 1
|
|
u(q + r) = 1
|
|
z = a(j): a(j) = a(i): a(i) = z 'Swap a(i), a(j)
|
|
p = i - a(i) + n
|
|
q = i + a(i) - 1
|
|
s(i) = j
|
|
j = i + 1
|
|
Loop Until j > n Or u(p) Or u(q + r)
|
|
If u(p) = 0 Then
|
|
If u(q + r) = 0 Then
|
|
m = m + 1 'm: number of solutions
|
|
If b Then
|
|
Debug.Print "n="; n; "m="; m
|
|
For k = 1 To n
|
|
For t = 1 To n
|
|
Debug.Print IIf(a(n - k + 1) = t, "Q", ".");
|
|
Next t
|
|
Debug.Print
|
|
Next k
|
|
End If
|
|
End If
|
|
End If
|
|
j = s(i)
|
|
Do While j >= n And i <> 0
|
|
Do
|
|
z = a(j): a(j) = a(i): a(i) = z 'Swap a(i), a(j)
|
|
j = j - 1
|
|
Loop Until j < i
|
|
i = i - 1
|
|
p = i - a(i) + n
|
|
q = i + a(i) - 1
|
|
j = s(i)
|
|
u(p) = 0
|
|
u(q + r) = 0
|
|
Loop
|
|
Loop Until i = 0
|
|
Debug.Print n, m 'number of queens, number of solutions
|
|
Next n
|
|
End Sub 'n_queens
|