|
begin process at 2008 07 19 08:50:05
 Derniers logiciels
|
Trouver une ressource (Nouvelle version du moteur, plus rapide & pertinent, essayez le !)
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
TOUS LES SUDOKU DU MONDE
 Information sur la source
 Description
Ce code illustre une nouvelle fois la récursivité. Il se charge de calculer tous les sudoku possibles selon ce que vous lui donnez en entrée. Si vous ne lui donnez rien, il se "contentera" de vous sortir toutes les grilles de sudoku existantes (oui oui, les 6'670'903'752'021'072'936'960. grilles possibles ! enfin, soyons franc, votre PC risque fortement d'être à court de mémoire avant que vous n'en voyez la couleur !). Le tout tient en moins de 80 lignes de code... vive la récursivité (la source est abondamment détaillée). En moyenne, il lui faut 0.2 secondes pour résoudre une grille diabolique... Je l'ai laissé tourner pendant une heure et demie sur mon PC, j'ai recu 2 000 000 de solutions...ce qui prend 1.52 Go (il y a une option pour enregistrer les solutions dans un fichier). Bonne lecture du code !
 Source
- Private Sub Solver(Grille_A_Solver() As Long)
- 'Fonction récursive principale : elle prend en paramètre une grille et cherche à la remplir.
- 'L'idée de base est d eprocéder par petits pas :
- 'Cette fonction cherche UN emplacement vide.
- 'Si elle n'en trouve pas, la grille passé en paramètre est déjà complète : parfaite.
- 'Si elle en trouve un, elle essaie successivement d'y placer les nombres de 1 à 9. Si elle peut placer par exemple un 1, elle s'auto appelle alors avec une grille un peu moins vide.
- 'De proche en proche, on obtien finalement une grille parfaitement remplie..et seules les combinaisons qui ont une probabilité d'être vraies sont testées.
-
- 'Pour un très bon tutorial sur la récursivité : (sous formes d'algorithmes)
- 'http://www.siteduzero.com/tuto-3-23774-1-la-recursivite.html
-
-
- Dim i As Long, j As Long, k As Long, Case_Etait_Vide As Boolean
-
- 'Si on a une solution et que l'on en a demandé une seule, c'est terminé !
- If Termine And Not (AfficherToutesSoluces) Then Exit Sub
- NBIterations = NBIterations + 1
-
- 'i,j => parcourent le tableau
- 'k parcourt les nombres de 1 à 9
- 'Case_Etait_Vide indique si on a effectué une opération sur le tableau
- Case_Etait_Vide = False
- For i = 1 To 9
- For j = 1 To 9
- If Grille_A_Solver(i, j) = 0 Then
- 'C'est une case vide, on va tenter de la remplir
- For k = 1 To 9
- If Try_To_Add(Grille_A_Solver, k, i, j) Then 'Si on a le droit d eplace k à l'emplacement i,j
- 'Remplir la grille avec ce nombre, et la passer en paramètre à Grille_A_Solver.
- Grille_A_Solver(i, j) = k
- Solver Grille_A_Solver()
- 'Puis la remettre à zéro pour la suite.
- Grille_A_Solver(i, j) = 0
- End If
- Next
- Case_Etait_Vide = True: Exit For
- End If
- Next
- If Case_Etait_Vide Then Exit For
- Next
-
- 'Si on a jamais trouvé de case vide, c'est fini !
- If Case_Etait_Vide = False Then
- NBSolutions = NBSolutions + 1
- AfficherSolution "TERMINE !!!! (Delta T = " & Int((Timer - Debut) * 100) / 100 & "s - Solution n°" & NBSolutions & ", cas traités : " & NBIterations & ")", Grille_A_Solver
- Termine = True
- DoEvents
- End If
- 'Debug.Print NBIterations
-
- End Sub
Private Sub Solver(Grille_A_Solver() As Long)
'Fonction récursive principale : elle prend en paramètre une grille et cherche à la remplir.
'L'idée de base est d eprocéder par petits pas :
'Cette fonction cherche UN emplacement vide.
'Si elle n'en trouve pas, la grille passé en paramètre est déjà complète : parfaite.
'Si elle en trouve un, elle essaie successivement d'y placer les nombres de 1 à 9. Si elle peut placer par exemple un 1, elle s'auto appelle alors avec une grille un peu moins vide.
'De proche en proche, on obtien finalement une grille parfaitement remplie..et seules les combinaisons qui ont une probabilité d'être vraies sont testées.
'Pour un très bon tutorial sur la récursivité : (sous formes d'algorithmes)
'http://www.siteduzero.com/tuto-3-23774-1-la-recursivite.html
Dim i As Long, j As Long, k As Long, Case_Etait_Vide As Boolean
'Si on a une solution et que l'on en a demandé une seule, c'est terminé !
If Termine And Not (AfficherToutesSoluces) Then Exit Sub
NBIterations = NBIterations + 1
'i,j => parcourent le tableau
'k parcourt les nombres de 1 à 9
'Case_Etait_Vide indique si on a effectué une opération sur le tableau
Case_Etait_Vide = False
For i = 1 To 9
For j = 1 To 9
If Grille_A_Solver(i, j) = 0 Then
'C'est une case vide, on va tenter de la remplir
For k = 1 To 9
If Try_To_Add(Grille_A_Solver, k, i, j) Then 'Si on a le droit d eplace k à l'emplacement i,j
'Remplir la grille avec ce nombre, et la passer en paramètre à Grille_A_Solver.
Grille_A_Solver(i, j) = k
Solver Grille_A_Solver()
'Puis la remettre à zéro pour la suite.
Grille_A_Solver(i, j) = 0
End If
Next
Case_Etait_Vide = True: Exit For
End If
Next
If Case_Etait_Vide Then Exit For
Next
'Si on a jamais trouvé de case vide, c'est fini !
If Case_Etait_Vide = False Then
NBSolutions = NBSolutions + 1
AfficherSolution "TERMINE !!!! (Delta T = " & Int((Timer - Debut) * 100) / 100 & "s - Solution n°" & NBSolutions & ", cas traités : " & NBIterations & ")", Grille_A_Solver
Termine = True
DoEvents
End If
'Debug.Print NBIterations
End Sub
Conclusion
 Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
 Télécharger le zip
 Historique
- 14 avril 2008 16:34:44 :
- Correction de mini-problèmes graphiques
Sources de la même categorie
 Commentaires
 Discussions en rapport avec ce code source
|
Téléchargements
Logiciels à télécharger sur le même thème :
|
|