Résolution de sudoku

**Xen3r0** · 06/04/2009, 10h51

Bonjour à tous,

Je suis en train de faire un algo pour résoudre une grille de sudoku. Le principe est assez simple : on recherche les cases où on peut avoir qu'une seul solution et on la remplie, et ainsi de suite jusqu'à qu'on est tous remplis.

Je vous fait part de mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
'Vérification de l'existant
Private Function chiffreExiste(ByVal NoLigne As Integer, ByVal NoCol As Integer, ByVal number As Integer) As Boolean
	Dim i As Integer 'Ligne de 1 à 9, soit 0 à 8 pour le tableau
	Dim j As Integer 'Colonne de 1 à 9, soit 0 à 8 pour le tableau
	Dim startCol As Integer
	Dim startLigne As Integer
 
	'Recherche sur la ligne
	For j = 0 To 8
		If (GrilleSolution((NoLigne - 1), j) = number) Then
			Return True
		End If
	Next
 
	'Recherche sur la colonne
	For i = 0 To 8
		If (GrilleSolution(i, (NoCol - 1)) = number) Then
			Return True
		End If
	Next
 
	'Recherche dans le carré
	If (NoCol > 0 And NoCol < 4) Then
		startCol = 0
	Else
		If (NoCol > 3 And NoCol < 6) Then
			startCol = 3
		Else
			startCol = 6
		End If
	End If
 
	If (NoLigne > 0 And NoLigne < 4) Then
		startLigne = 0
	Else
		If (NoLigne > 3 And NoLigne < 6) Then
			startLigne = 3
		Else
			startLigne = 6
		End If
	End If
 
	For i = startLigne To (startLigne + 2)
		For j = startCol To (startCol + 2)
			If (GrilleSolution(i, j) = number) Then
				Return True
			End If
		Next
	Next
 
	Return False
End Function
 
'Résolution de la grille de facon récursive
Private Sub getPossibilite()
	Dim i As Integer 'Ligne de 1 à 9, soit 0 à 8 pour le tableau
	Dim j As Integer 'Colonne de 1 à 9, soit 0 à 8 pour le tableau
	Dim num As Integer
	Dim onlyOne As Boolean
 
	onlyOne = False
 
	For i = 1 To 9
		For j = 1 To 9
			GrillePossible((i - 1), (j - 1)) = ""
 
			For num = 1 To 9
				If (Not chiffreExiste(i, j, num)) Then
					If (GrilleSolution((i - 1), (j - 1)) = 0) Then
						GrillePossible((i - 1), (j - 1)) = GrillePossible((i - 1), (j - 1)) & CStr(num)
					End If
				End If
			Next
		Next
	Next
 
	For i = 1 To 9
		For j = 1 To 9
			Debug.Print(i & "/" & j & " : " & GrillePossible((i - 1), (j - 1)))
			If (Len(GrillePossible((i - 1), (j - 1))) = 1) Then
				Me.Controls.Find("TxtCase" & i & "_" & j, True)(0).Text = CInt(GrillePossible((i - 1), (j - 1)))
				GrilleSolution((i - 1), (j - 1)) = CInt(GrillePossible((i - 1), (j - 1)))
				onlyOne = True
			End If
		Next
	Next
 
	If (onlyOne) Then
		Call getPossibilite()
	End If
End Sub

Le problème c'est que les chiffres après le deuxième appel de la procédure ne correspondent plus à la solution que doit avoir la grille.

Merci beaucoup.