Hallo,
ich lerne gerade ein bisschen mit Visual Basic zu programmieren und muss einen Sudoku Solver erstellen. Bis jetzt habe ich leider nicht wirklich viel Ahnung vom Programmieren
Ich habe mir vorgenommen einen Solver mit Backtracking zu erstellen und auch schon etwas Code geschrieben. Nur leider hackt es noch an einigen Stellen.
Vielleicht kann mir ja jemand von euch weiterhelfen, das wäre wirklich super!
Ich denke es hängt vor allem noch an der Backtracking Funktion. Außerdem kann ich diese Funktion auch nicht aus dem Button Sub aufrufen
Schon einmal vielen Dank falls Ihr mir helfen könnt.
Ich hoffe ich habe den Thread im richtigen Unterforum erstellt.
Hier ist der Quellcode mit meinen "Erläuterungen":
Spoiler anzeigen
ich lerne gerade ein bisschen mit Visual Basic zu programmieren und muss einen Sudoku Solver erstellen. Bis jetzt habe ich leider nicht wirklich viel Ahnung vom Programmieren
Ich habe mir vorgenommen einen Solver mit Backtracking zu erstellen und auch schon etwas Code geschrieben. Nur leider hackt es noch an einigen Stellen.
Vielleicht kann mir ja jemand von euch weiterhelfen, das wäre wirklich super!
Ich denke es hängt vor allem noch an der Backtracking Funktion. Außerdem kann ich diese Funktion auch nicht aus dem Button Sub aufrufen
Schon einmal vielen Dank falls Ihr mir helfen könnt.
Ich hoffe ich habe den Thread im richtigen Unterforum erstellt.
Hier ist der Quellcode mit meinen "Erläuterungen":
VB.NET-Quellcode
- Public Class Form1
- Dim ncells As Integer = 8 'here input of the line / column number of sudoku cells
- Dim sudoku(0 To ncells, 0 To ncells) As Integer '2 dimensional array for sudoku grid. it is used to save the sudoku solution. if this didn't exsit, the program would be slow because too much time to fill in all the boxes.
- Dim number As Integer
- Dim scell(0 To ncells, 0 To ncells) As TextBox '2 dimensional array (i, j) with which the sudoku will be created
- Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
- For i As Integer = 0 To ncells
- For j As Integer = 0 To ncells
- scell(i, j) = New TextBox 'for every element in the cell I create new sudoku cell
- scell(i, j).MinimumSize = New Size(50, 50) 'the size of the cell is defined
- scell(i, j).Text = ""
- scell(i, j).Font = New Font(scell(i, j).Font.FontFamily, 25, FontStyle.Regular) 'the size of the text input is defined
- scell(i, j).TextAlign = HorizontalAlignment.Center 'input is centered
- scell(i, j).Width = 50 'the cell width is defined
- scell(i, j).Location = New Point(i * 50, j * 50) 'the cells are located depending on their index
- scell(i, j).BorderStyle = BorderStyle.FixedSingle 'the style of the cells is defined
- scell(i, j).MaxLength = 1 'the input can only be one character
- Me.Controls.Add(scell(i, j)) 'the cells are added to the form
- Next
- Next
- End Sub
- 'this function checks whether the number assigned is already existant in the line
- Function testlines(ByVal jcolumns As Integer, ByVal number As Integer, ByVal sudoku(,) As Object) As Boolean
- testlines = True 'in the beginning it is assumed that there is no clash. Then it is checked whether there might be a clash
- Dim i As Integer
- For i = 0 To ncells 'the lines are indexed
- If sudoku(i, jcolumns) = number Then
- testlines = False 'if there is a cell in the line which has the same number like another one, then there is a clash
- Exit Function
- End If
- Next i
- End Function
- ' this function checks whether the number assigned is already existant in the column
- Function testcolumns(ByVal ilines As Integer, ByVal number As Integer, ByVal sudoku(,) As Object) As Boolean
- testcolumns = True 'in the beginning it is assumed that there is no clash. Then it is checked whether there might be a clash
- Dim j As Integer
- For j = 0 To ncells 'the columns are indexed
- If sudoku(ilines, j) = number Then
- testcolumns = False 'if there is a cell in the column which has the same number like another one, then there is a clash
- Exit Function
- End If
- Next j
- End Function
- Function testboxes(ByVal ilines As Integer, ByVal jcolumns As Integer, ByVal number As Integer, ByVal sudoku(,) As Object) As Boolean
- testboxes = True
- Dim istart As Integer
- Dim jstart As Integer
- Dim i As Integer
- Dim j As Integer
- 'now I define that only the 9 3x3 boxes are checked for clashes
- 'lines 1-3 are summarized to 1 big line:
- If ilines < 3 Then
- istart = 0
- 'lines 4-6 are summarizes to 1 big line:
- ElseIf ilines < 6 Then
- istart = 3
- 'lines 7-9 are summarizes to 1 big line:
- Else
- istart = 6
- End If
- 'columns 1-3 are summarized to 1 big column:
- If jcolumns < 3 Then
- jstart = 0
- 'columns 4-6 are summarized to 1 big column:
- ElseIf jcolumns < 6 Then
- jstart = 3
- 'columns 7-9 are summarized to 1 big column:
- Else
- jstart = 6
- End If
- For i = 0 To (istart + 2) 'the +2 because istart was defined to be maximum 6
- For j = 0 To (jstart + 2) 'the +2 because jstart was defined to be maximum 6
- If sudoku(i, j) = number Then 'it is checked whether there is a clash in the 9 3x3 boxes
- testboxes = False
- Exit Function
- End If
- Next j
- Next i
- End Function
- 'this function summarizes all the the functions above and returns only true, if
- Function safe(ByVal i As Integer, ByVal j As Integer, ByVal number As Integer, ByVal sudoku(,) As Object) As Boolean
- safe = False
- If testlines(j, number, sudoku) = True And testcolumns(i, number, sudoku) = True And testboxes(i, j, number, sudoku) = True Then
- safe = True
- Exit Function
- End If
- End Function
- Function solve(ByVal i As Integer, ByVal j As Integer, ByVal sudoku(,) As Object) As Boolean
- Dim number As Integer
- Dim copyi As Integer
- Dim copyj As Integer
- 'first check whether the cell is empty / if it is not empty, then check whether cell 81 / if cell 81, then sudoku solved
- If sudoku(i, j) <> "" Then
- If i = ncells And j = ncells Then
- solve = True
- Exit Function
- 'if it is not empy I jump to the next cell by calling the sub nextcell() / then I call the function solve again
- Else
- nextcell(i, j)
- solve(i, j, sudoku)
- 'now I assign the numbers 1 to 9 to the variable number and check whether they comply with the restrictions / afterwards I check again whether I am already at cell 81 / if cell 81, then sudoku solved
- 'I also make copies of the cells i and j and go on with the copies / by doing that I can jump back to the "old" i and j indexes if the new number does not comply with the restrictions
- number = 1
- Do Until number = 10
- If safe(i, j, number, sudoku) = True Then
- sudoku(i, j) = number
- If i = ncells And j = ncells Then
- solve = True
- Exit Function
- Else
- copyi = i
- copyj = j
- nextcell(copyi, copyj) 'sicherstellen, dass kopien gelöscht werden ??
- If solve(copyi, copyj, sudoku) = True Then
- Return True
- Else
- sudoku(i, j) = ""
- Return False
- End If
- End If
- End If
- number = number + 1
- Loop
- End If
- End If
- End Function
- 'this sub delivers the coordinates for the next cell in the sudoku grid
- Sub nextcell(ByVal i As Integer, ByVal j As Integer)
- If i = 8 Then
- i = 0
- j = j + 1
- Else
- i = i + 1
- End If
- End Sub
- 'This sub does, if the button solve is clicked: It loads the current values that are put in the grid in the 2-dimensional array / After that the function solve starts
- 'After the function solve is finished, the filled array is loaded in the cells, meaning the solved sudoku is shown.
- Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
- For i As Integer = 0 To ncells
- For j As Integer = 0 To ncells
- sudoku(i, j) = Convert.ToInt16(scell(i, j).Text)
- Next
- Next
- solve(0, 0, 0)
- For i = 0 To ncells
- For j = 0 To ncells
- scell(i, j).Text = Convert.ToString(sudoku(i, j))
- Next
- Next
- End Sub
Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „clancy700“ ()