'Visual Basic 2010 Recursie Procedures en Functies
Module NQueensProblem
    ' Problem :
    ' How to assign N queens to N positions on a N by N chessboard, so that no
    ' queen can attack any other queen on the board.
    '
    ' Configuration :
    Const N As Integer = 8
    '
    Dim chessBoard(N - 1, N - 1) As Boolean
    ' elements contain True if queen is assigned to according position
    '
    Sub Main()
        If CanSolve(N) Then
            Console.WriteLine("A solution is found :")
            DrawChessBoard()
        Else
            Console.WriteLine("No solution is found.")
        End If
        '
        Console.ReadLine()
    End Sub
    Sub DrawChessBoard()
        Console.Write("+")
        For col As Integer = 0 To N - 1
            Console.Write("---+")
        Next
        Console.WriteLine()
        For row As Integer = 0 To N - 1
            Console.Write("|")
            For col As Integer = 0 To N - 1
                If HasQueen(row, col) Then
                    Console.Write(" Q |")
                Else
                    Console.Write("   |")
                End If
            Next
            Console.WriteLine()
            Console.Write("+")
            For col As Integer = 0 To N - 1
                Console.Write("---+")
            Next
            Console.WriteLine()
        Next
        Console.WriteLine()
    End Sub
    Function CanSolve(ByVal queens As Integer) As Boolean
        If queens = 0 Then
            CanSolve = True
        Else
            Dim col As Integer = N - queens
            Dim rowToTry As Integer = 0
            Do
                If IsUnderAttack(rowToTry, col) Then
                    rowToTry += 1
                Else
                    PlaceQueen(rowToTry, col)
                    Console.WriteLine("Trying :")                          ' (*)
                    DrawChessBoard()                                       ' (*)
                    CanSolve = CanSolve(queens - 1)
                    If Not CanSolve Then
                        RemoveQueen(rowToTry, col)
                        Console.WriteLine("Backtracking to :")             ' (*)
                        DrawChessBoard()                                   ' (*)
                        rowToTry += 1
                    End If
                End If
            Loop Until CanSolve OrElse Not IsLegalPosition(rowToTry, col)
        End If
        ' (*) for debugging purposes
    End Function
    Function IsUnderAttack(ByVal row As Integer, ByVal col As Integer) As Boolean
        IsUnderAttack = IsUnderAttack(row, col, -1, -1) OrElse _
                        IsUnderAttack(row, col, +1, -1) OrElse _
                        IsUnderAttack(row, col, 0, -1)
    End Function
    Function IsUnderAttack(ByVal row As Integer, ByVal col As Integer, _
                           ByVal rowOffSet As Integer, ByVal colOffSet As Integer) As Boolean
        Do
            row += rowOffSet
            col += colOffSet
        Loop While IsLegalPosition(row, col) AndAlso Not HasQueen(row, col)
        IsUnderAttack = HasQueen(row, col)
    End Function
    Function HasQueen(ByVal row As Integer, ByVal col As Integer) As Boolean
        HasQueen = IsLegalPosition(row, col) AndAlso chessBoard(row, col)
    End Function
    Function IsLegalPosition(ByVal row As Integer, ByVal col As Integer) As Boolean
        IsLegalPosition = row >= 0 AndAlso row <= N - 1 AndAlso col >= 0 AndAlso col <= N - 1
    End Function
    Sub PlaceQueen(ByVal row As Integer, ByVal col As Integer)
        chessBoard(row, col) = True
    End Sub
    Sub RemoveQueen(ByVal row As Integer, ByVal col As Integer)
        chessBoard(row, col) = False
    End Sub
End Module
'Bezoek www.vbvoorbeelden.be voor meer Visual Basic voorbeelden.
'Copyright - De Wolf / vbvoorbeelden - 2003-2011 - Alle rechten voorbehouden.