Backtracking algorithm

[Troy Lundin]

Searching the internet for an example of backtracking in VB.Net has proven fruitless. All the examples I found were either in a language I don't understand (making it impossible for me to convert it to vb.net) or they contained zero commenting (making it difficult to actually understand what is going on).

Does anyone have an example of backtracking in VB.Net? Commenting would be useful so I don't have to decipher single letter variables.

[.paul.]

what is backtracking?

you might get more answers if you can explain what you're trying to do

[Troy Lundin]

Backtracking

[Shaggy Hiker]

That's pretty neat, though I have never seen it. Something else you might take a look at is a steepest climb algorithm. Of course, that is just a guess at where you want to go with backtracking. However, I would suggest that there is no right answer for this, and any example, as long as it solved a problem sufficiently differnet from the specific one you are working on, would provide you with little benefit. For example, I have written several genetic algorithms. They all have the same components, but the location of those components, and their relationships, differs radically, depending on what a gene looks like. If a gene is a simple as a bit, then the whole GA can be quite compact (a single class, even), whereas if a gene is a class or structure, then the GA can be an entire map of genes. I doubt that anybody who looked at the bit version of the GA would readily anticipate the class version of the GA. I would guess that backtracking falls into the same category.

[minitech]

Which languages are they in? I can translate C#, C, C++ and Java for you.

[Troy Lundin]

I found this example of cpp code.

I tried to convert it to VB and came up with this.

Public Class Form1
    Dim x(30) As Integer
    Dim n As Integer = 16

    Function Possible(ByVal k As Integer) As Integer
        For i As Integer = 1 To k
            If x(i) = x(k) OrElse Math.Abs(x(i) - x(k)) = k - 1 Then
                Return 0
            End If
            Return 1
        Next
    End Function

    Function Solution(ByVal k As Integer) As Integer
        Return k = n
    End Function

    Sub Back(ByVal k As Integer)
        If Solution(k) Then
            For i As Integer = 1 To k + 1
                TextBox1.Text &= x(i)
            Next
        Else
            Dim temp As Integer = x(k + 1)
            For temp = 1 To n
                x(k + 1) += 1
                If Possible(k + 1) Then
                    Back(k + 1)
                End If
            Next
        End If
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Back(0)
    End Sub
End Class

The VB code does nothing. It just outputs 0.

I believe it does have something to do with genetic algorithms (another thing I cannot find vb.net sources of) as the term is used in certain backtracking posts. If your genetic algorithms are well commented I would like to look at them and see if I can learn anything from them.

[Troy Lundin]

I am going to bump this up as I am still looking for a VB example of this algorithm.

[Milk]

I think I already said I don't have VB.Net installed, I think I've got the procedures correct but you will no doubt find a few syntax errors, I've left the class definition off...

    Private x(30) As Integer
    Private n As Integer
	
    Public Sub N_Queens_On_A_NxN_CheessTable(ByVal N As Integer)
        If N < 1 OrElse N > 30 Then 
            Throw New ArgumentOutOfRangeException("N", "N must be greater than 0 and less than 31.")
    	End if	
        n = N
        Back(0)
    End sub

    Private Sub Back(ByVal k As Integer)
        If Solution(k) Then
            Display(k)
        Else
            k += 1 'to avoid all that k+1
            x(k)=1
            While x(k) <= n
                if Possible(k) then
                    Back(k)
                    'Exit Sub <-- try with and without this line, I think it's doing more work than needed
                End if
                x(k)+=1
            End while
        End if			
    End Sub
	
    Private Function Possible(ByVal k As Integer) As Boolean
        For i As Integer = 1 To k - 1
            If (x(i) = x(k)) OrElse (Math.Abs(x(i) - x(k)) = k - 1) Then Return False
        Next                
        Return True
    End Function
	
    Private Function Solution(ByVal k As Integer) As Boolean
        Return k = n
    End Function

    Private Sub Display(k as integer)
        For i As Integer = 1 To k 
            Console.Write("{0} ", x(i))
        next
        Console.WriteLine()
    End Sub

I'm guessing the output string indicates the queens row index for each respective column.

AFAIK x(0) is never used.

[Troy Lundin]

Ok, thanks for that conversion. It produces the two correct solutions, but also produces two incorrect ones. I'll try and look for another example.

Also, the n = N in your first Sub wouldn't work, so I changed the argument to Num.

[dbasnett]

Which languages are they in? I can translate C#, C, C++ and Java for you.

Here is a C# version

http://www.c-sharpcorner.com/UploadF...ensPuzzle.aspx

[minitech]

I actually couldn't use the computer for a while, so I printed it out using the iPhone and translated it on paper. It's simple code, and here it is:

Dim n As Integer, x(30) As Integer
Function Solution(k As Integer) As Boolean
     Return (k = n)
End Function
Sub Print(k As Integer)
     For i As Integer = 1 To k
          Console.Write(x(i).ToString() & " ")
     Next
     Console.WriteLine()
End Sub
Function Possible(k As Integer) As Boolean
     For i As Integer = 1 To k - 1
          If x(i) = x(k) OrElse Math.Abs(x(i)-x(k)=k-i Then Return False
     Next
     Return True
End Function
Sub Back(k As Integer)
     If Solution(k) Then
          Print(k)
     Else
          x(k + 1) = 1
          While x(k+1) <= n
               back(k + 1)
               x(k+1) += 1
          End While
     End If
End Sub
Sub Main()
     Console.Write("Please enter size of chessboard: ")
     If Integer.TryParse(Console.ReadLine(),n) Then
          Console.Write(vbCrLf & "The solution: ")
          Back(0)
     End If
End Sub

Put this in a module.

[dbasnett]

@mini - is that the translated 8 queens C# I posted?

[minitech]

No, it's the translated C++.

[dbasnett]

I have heard of people using Backtracking for Sudoku puzzles? Is that correct. I didn't do that when I wrote a Sudoku puzzle generator, wonder if Backtracking is a faster implementation?

[MaximilianMayrhofer]

I used backtracking for my puzzle generator. Even when I implemented the algorithm in Java, which is bloody slow, I was able to generate highly difficult (20-23 remaining numbers), unique puzzles at a rate of 10-15 per second.

[dbasnett]

Mine is just randomly generated, fast but probably not difficult puzzles. I don't Soduku.

Public Class Form1

    Dim baseStr As String = "abcdefghi"
    Dim StrBaseL As New List(Of System.Text.StringBuilder)
    Dim solved As New List(Of System.Text.StringBuilder)
    Dim myRnd As New Random
    Dim SubD As Dictionary(Of String, Integer)

    'a button, label and richtextbox needed
    Private Sub Button1_Click(ByVal sender As System.Object, _
                              ByVal e As System.EventArgs) Handles Button1.Click
        Dim stpw As New Stopwatch
        stpw.Reset()
        stpw.Start()
        CreateBase()
        'ShwPrg()
        ScrmbldEgss()
        'ShwPrg()
        LtrToNum()
        'remember solution
        solved = New List(Of System.Text.StringBuilder)
        For x As Integer = 0 To StrBaseL.Count - 1
            solved.Add(New System.Text.StringBuilder)
            solved(x).Append(StrBaseL(x))
        Next
        RmvNum(5) 'remove numbers from puzzle 
        stpw.Stop()
        Label1.Text = stpw.ElapsedMilliseconds.ToString
        ShwPrg() 'show the puzzle
    End Sub

    Private Sub RmvNum(ByVal RemoveCount As Integer)
        'RemoveCount = count of numbers to remove from each block
        Dim cts(2, 2) As Integer 'hold counts per block
        Dim exitCond As Integer = 0
        Dim x, y, ctx, cty As Integer
        Do
            exitCond = 9 * RemoveCount 'set exit count
            Do
                x = myRnd.Next(0, 9) 'get random numbers 0 -8
                y = myRnd.Next(0, 9)
                ctx = CInt(Math.Floor(x / 3)) 'convert to blocks coordinates
                cty = CInt(Math.Floor(y / 3))
                'check if removal needed and not removed already
                If cts(ctx, cty) < RemoveCount AndAlso StrBaseL(x)(y) <> "*"c Then
                    cts(ctx, cty) += 1
                    StrBaseL(x)(y) = "*"c
                    If cts(ctx, cty) = RemoveCount Then 'has this block had enough removed
                        'yes
                        exitCond -= RemoveCount 'decrement exit condition
                    End If
                End If
            Loop While exitCond > 0 'loop while more to do
        Loop While exitCond > 0

    End Sub

    Private Sub ScrmbldEgss()
        For x As Integer = 0 To 8
            'do some scrambling
            ScrmblCol()
            ScrmblCol()
            ScrmblRow()
            'ShwPrg()
        Next
    End Sub

    Private Sub ScrmblRow()
        'move rows around
        Dim rowG As Integer = myRnd.Next(0, 3) 'which group of 3 row
        Dim stRW As Integer = rowG * 3 'start row
        Dim eRW As Integer = ((rowG + 1) * 3) 'end row + 1 for insert
        Dim numRW As Integer = myRnd.Next(0, 3) 'how many to move 0-2!
        For x = stRW To stRW + numRW
            StrBaseL.Insert(eRW, StrBaseL(x)) 'insert the row we are about to remove
            StrBaseL.RemoveAt(x)
        Next
    End Sub

    Private Sub ScrmblCol()
        'move columns around
        Dim colG As Integer = myRnd.Next(0, 3) 'which group of 3 column
        Dim stCH As Integer = colG * 3 'start column
        Dim eCH As Integer = ((colG + 1) * 3) 'insert before column
        Dim numCol As Integer = myRnd.Next(0, 3) 'how many to move 0-2!
        For x = 0 To numCol
            For z As Integer = 0 To StrBaseL.Count - 1
                StrBaseL(z).Insert(eCH, StrBaseL(z)(stCH + x)) 'insert the char we are about to remove
                StrBaseL(z).Remove(stCH + x, 1) 'remove it
            Next
        Next
    End Sub

    Private Sub LtrToNum()
        'convert letters to numbers
        'which is why i started with letters
        For z As Integer = 0 To StrBaseL.Count - 1
            For Each de As KeyValuePair(Of String, Integer) In SubD
                'replace the letter with the number
                StrBaseL(z).Replace(de.Key, de.Value.ToString)
            Next
        Next
    End Sub

    Private Sub ShwPrg()
        RichTextBox1.Clear()
        For z As Integer = 0 To StrBaseL.Count - 1
            Dim s As String = StrBaseL(z).ToString
            For x As Integer = 0 To s.Length - 1 Step 3
                RichTextBox1.AppendText(s.Substring(x, 3) & " ") 'groups of 3
            Next
            RichTextBox1.AppendText(Environment.NewLine)
            If z Mod 3 = 2 Then RichTextBox1.AppendText(Environment.NewLine) 'groups of three
        Next
        RichTextBox1.Refresh()
    End Sub

    Private Sub CreateBase()
        Dim foo As New System.Text.StringBuilder
        foo.Append(baseStr) 'append the staring string
        Dim thisBS As String = "" 'the working string
        SubD = New Dictionary(Of String, Integer) 're-create the dictionary
        Dim i, j As Integer
        Dim v As New List(Of Integer)
        For x As Integer = 1 To 9 'add 1 to 9 to list for random selection later
            v.Add(x)
        Next
        'scramble the base letters and build the dictionary
        Do
            i = myRnd.Next(0, foo.Length) 'pick random letter and number
            j = myRnd.Next(0, v.Count)
            thisBS &= foo(i) 'build working string
            SubD.Add(foo(i), v(j)) 'add entry to dictionary
            foo.Remove(i, 1) 'remove values we just used
            v.RemoveAt(j)
        Loop While foo.Length > 0

        StrBaseL = New List(Of System.Text.StringBuilder) 'create new list

        For x As Integer = 0 To 2 'add 3 rows
            StrBaseL.Add(New System.Text.StringBuilder)
            StrBaseL(x).Append(thisBS) 'append the base text
            For y As Integer = 1 To x 'shift 3 characters
                For z As Integer = 1 To 3
                    StrBaseL(x).Append(StrBaseL(x)(0)) 'append char@(0)
                    StrBaseL(x).Remove(0, 1) 'then remove it
                Next
            Next
        Next

        'take the first three rows, add them shifted one char
        For x As Integer = 3 To 5 'add 3 more rows
            StrBaseL.Add(New System.Text.StringBuilder)
            StrBaseL(x).Append(StrBaseL(x - 3)) 'append the base text
            StrBaseL(x).Append(StrBaseL(x)(0)) 'append char@(0)
            StrBaseL(x).Remove(0, 1) 'then remove it
        Next

        'take the second group of three rows, add them shifted one char
        For x As Integer = 6 To 8 'add 3 more rows
            StrBaseL.Add(New System.Text.StringBuilder)
            StrBaseL(x).Append(StrBaseL(x - 3)) 'append the base text
            StrBaseL(x).Append(StrBaseL(x)(0)) 'append char@(0)
            StrBaseL(x).Remove(0, 1) 'then remove it
        Next

    End Sub

End Class

[dbasnett]

I used backtracking for my puzzle generator. Even when I implemented the algorithm in Java, which is bloody slow, I was able to generate highly difficult (20-23 remaining numbers), unique puzzles at a rate of 10-15 per second.

Do you have it in VB? Would you post it?