[XL-2010] Algorithme génération sudoku

Algorithme génération sudoku

Bonjour à tous je cherche desespérement à faire un code qui génère un sudoku en VBA cependant après avoir essayer avec diverses méthode je n'y arrive pas.
J'ai vu beaucoup de sujet là dessus mais aucun ne m'a REELLEMENT éclairé pourriez vous m'aider ?

PS : je parle bien d'un algorithme et non d'un code j'ai juste besoin du concept de base pour progresser

Merci à vous

Est-ce que tu parles de créer une nouvelle grille de Sudoku ou de résoudre une grille donnée ?

Bonsoir,

En fait pour créer un sudoku valide il faut être capable de le résoudre par code.

https://www.dewep.net/realisations/c...-en-javascript

Citation:

Envoyé par dysorthographie

En fait pour créer un sudoku valide il faut être capable de le résoudre par code.

Autre méthode (quand on est fainéant) : tu prends une grille valide, tu permutes des lignes dans les groupes de 3, tu permutes des groupes de 3 entre eux, tu fais la même chose avec les colonnes, tu fais une permutation aussi de chiffres et... abracadabra... tu as une grille qui ne ressemble plus du tout à sa grille mère mais qui est tout aussi valable.

Avec cette méthode, une seul grille de Sudoku peut en générer des centaines de milliers.
C'est une méthode qui est très connue des marchands de grilles et qui fait que ce jeu est beaucoup plus rentable que des mots fléchés. :mouarf:

Je cherche bien à générer des grilles.

D'accord mais même si on doit pouvoir en résoudre un, quel serait l'algorithme de la génération et de la résolution ?

Merci

Citation:

Envoyé par m.peres.97

D'accord mais même si on doit pouvoir en résoudre un, quel serait l'algorithme de la génération et de la résolution ?

Je ne vois que deux méthodes :

Soit tu récupères une dizaine de grilles et tu utilises la méthode "fainéant" que je décris dans mon post précédent, ce qui te permettra d'en générer quelques millions (méthode simple et rapide qui te permet même d'assigner une difficulté).
Edit : j'ai fait un rapide calcul : à partir d'une grille, on peut en fabriquer ainsi plus de 1000 milliards ( 3!^8 x 9! x 2). :mrgreen:

Soit tu génères des grilles aléatoires que tu testes avec un algorithme de résolution pour vérifier qu'il y a une (et une seule) solution.

Mais trouver l'algorithme de création de grille est un problème qui n'a rien à voir avec VBA Excel.

Pour ce qui est de la résolution, j'avais fait ça il y a quelques années :

Code:

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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
Sub SDK2()
 
   Y_TpsStart = Timer
 
   ' Consultation du tableau
 
   For Y_L = 1 To 9
      For Y_C = 1 To 9
         Y_Y = (Y_L - 1) * 9 + Y_C
         Y_YL(Y_Y) = Y_L
         Y_YC(Y_Y) = Y_C
 
         Select Case ActiveSheet.Cells(Y_L, Y_C).Value
         Case 1 To 9
            Y_Cur(Y_L, Y_C) = ActiveSheet.Cells(Y_L, Y_C).Value
            Y_Fix(Y_L, Y_C) = True
         Case Else
            Y_Cur(Y_L, Y_C) = 0
            Y_Fix(Y_L, Y_C) = False
         End Select
      Next Y_C
   Next Y_L
 
   ' recherche
 
   Y_Y = 1
   Do While Y_Y <= 81
      Y_L = Y_YL(Y_Y)
      Y_C = Y_YC(Y_Y)
 
      If Y_Fix(Y_L, Y_C) Then
         Y_Y = Y_Y + 1
      Else
         Y_Cur(Y_L, Y_C) = Y_Cur(Y_L, Y_C) + 1
 
         Do While Y_Cur(Y_L, Y_C) <= 9
            If SDK_Test() Then Exit Do
            Y_Cur(Y_L, Y_C) = Y_Cur(Y_L, Y_C) + 1
         Loop
 
         If Y_Cur(Y_L, Y_C) <= 9 Then   ' viable
            Y_Y = Y_Y + 1
         Else
            Y_Cur(Y_L, Y_C) = 0
            Do
               Y_Y = Y_Y - 1
               Y_L = Y_YL(Y_Y)
               Y_C = Y_YC(Y_Y)
            Loop Until Not Y_Fix(Y_L, Y_C)
         End If
 
      End If
   Loop
 
   ' Affichage du résultat
 
   For Y_L = 1 To 9
      For Y_C = 1 To 9
         If Y_Fix(Y_L, Y_C) Then
            ActiveSheet.Cells(Y_L, Y_C).Font.Color = RGB(200, 0, 0)
         Else
            ActiveSheet.Cells(Y_L, Y_C).Value = Y_Cur(Y_L, Y_C)
            ActiveSheet.Cells(Y_L, Y_C).Font.Color = RGB(0, 0, 255)
         End If
      Next Y_C
   Next Y_L
 
   ActiveSheet.Cells(1, 13).Value = Y_TpsStart
   ActiveSheet.Cells(2, 13).Value = Timer
   ActiveSheet.Cells(3, 13).Value = Timer - Y_TpsStart
 
End Sub
Public Function SDK_Test() As Boolean
 
   SDK_Test = False
 
   ' RAZ
   For Y_I = 1 To 9
      Y_Test(Y_I, 1) = False
      Y_Test(Y_I, 2) = False
      Y_Test(Y_I, 3) = False
   Next Y_I
 
   ' Ligne et colonne
   For Y_I = 1 To 9
      Y_T = Y_Cur(Y_I, Y_C)
      If Y_T > 0 Then
         If Y_Test(Y_T, 1) Then Exit Function
         Y_Test(Y_T, 1) = True
      End If
 
      Y_T = Y_Cur(Y_L, Y_I)
      If Y_T > 0 Then
         If Y_Test(Y_T, 2) Then Exit Function
         Y_Test(Y_T, 2) = True
      End If
   Next Y_I
 
   ' en carré
   Y_I0 = Y_L - (Y_L - 1) Mod 3
   Y_J0 = Y_C - (Y_C - 1) Mod 3
   For Y_I = 0 To 2
      For Y_J = 0 To 2
         Y_T = Y_Cur(Y_I0 + Y_I, Y_J0 + Y_J)
         If Y_T > 0 Then
            If Y_Test(Y_T, 3) Then Exit Function
            Y_Test(Y_T, 3) = True
         End If
      Next Y_J
   Next Y_I
 
   SDK_Test = True
 
End Function

Je n'ai pas trouvé de grille classique qui résiste plus d'un dixième de seconde à ce code.

Je vais regarder ça merci ;)