Printable View
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. :D
what is backtracking?
you might get more answers if you can explain what you're trying to do
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.
Which languages are they in? I can translate C#, C, C++ and Java for you.
I found this example of cpp code.
I tried to convert it to VB and came up with this.
The VB code does nothing. It just outputs 0.Code: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
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.
I am going to bump this up as I am still looking for a VB example of this algorithm.
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...I'm guessing the output string indicates the queens row index for each respective column.Code: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
AFAIK x(0) is never used.
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.
Here is a C# versionQuote:
Originally Posted by minitech
http://www.c-sharpcorner.com/UploadF...ensPuzzle.aspx
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:
Put this in a module.Code: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
@mini - is that the translated 8 queens C# I posted?
No, it's the translated C++.
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?
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.
Mine is just randomly generated, fast but probably not difficult puzzles. I don't Soduku.
Code: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
Do you have it in VB? Would you post it?Quote:
Originally Posted by MaximilianMayrhofer