Résoudre une grille de SUDOKU

J'ai fait un petit programme sans prétention qui est capable de résoudre n'importe quelle grille de SUDOKU, en quelques secondes voir minutes. Essayez-le, voici le code:

Code:: ' SUDOKU solution

label effacer, charger, resoudre, verif
label nextlig, nextcol, nextval, finish, tester, inex

dim lig%, col%, obj%, v%, erreur%, lb%, cb%, l%, c%, ld%, cd%, xlig%, xcol%, i%, affic%
dim sudoku%(9,9), revele%(9,9), flags%(9)

for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
edit obj%
left obj%,100+col%*30
top obj%,100+lig%*30
width obj%,20
next col%
next lig%

2d_line 120,125,395,125
2d_line 120,395,395,395
2d_line 120,125,120,395
2d_line 395,125,395,395
2d_line 120,215,395,215
2d_line 120,305,395,305
2d_line 215,125,215,395
2d_line 305,125,305,395

button 501
top 501,10
left 501,10
caption 501,"Effacer"
hint 501,"Vider la grille"
on_click 501,effacer

button 502
top 502,10
left 502,100
caption 502,"Charger"
hint 502,"Charger la configuration saisie dans la grille"
on_click 502,charger

button 503
inactive 503
top 503,10
left 503,190
caption 503,"Résoudre"
hint 503,"Résoudre la grille"
on_click 503,resoudre

option 504
top 504,50
left 504,10
caption 504,"Afficher progression"
hint 504,"Afficher l'évolution des nombres calculés"

end

' effacer les tableaux
effacer:
for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
font_color obj%,0,0,0
font_bold_off obj%
text obj%,""
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
next col%
next lig%
inactive 503
return

' charger le tableau
charger:
for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
if text$(obj%)=""
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
font_color obj%,0,0,255
else
if numeric(text$(obj%))=1
v% = val(text$(obj%))
if v%<1 or v%>9
text obj%,"?"
v% = 0
end_if
sudoku%(lig%,col%) = v%
if v%>0
revele%(lig%,col%) = 1
font_bold obj%
text obj%,str$(v%)
end_if
else
text obj%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
end_if
end_if
next col%
next lig%
gosub verif
if erreur%=1
v% = message_error_OK("La grille est incohérente !")
else
active 503
end_if
return

' vérifier la cohérence du tableau
verif:
erreur% = 0
for lig%=1 to 9 : ' test des lignes
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
font_bold_off l%-1)*9+c%
text (lig%-1)*9+col%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
next lig%
for col%=1 to 9 : ' test des colonnes
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
font_bold_off l%-1)*9+c%
text (lig%-1)*9+col%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
next col%
lig% = 1 : ' test des carrés
while lig%<9
col% = 1
while col%<9
lb% = 0
cb% = 0
while lb%<3
if sudoku%(lig%+lb%,col%+cb%)>0
for l%=lig% to lig%+2
for c%=col% to col%+2
if l%<>(lig%+lb%) and c%<>(col%+cb%)
if (sudoku%(l%,c%)>0) and (sudoku%(l%,c%)=sudoku%(lig%+lb%,col%+cb%))
font_bold_off l%-1)*9+c%
text (l%-1)*9+c%,"?"
sudoku%(l%,c%) = 0
revele%(l%,c%) = 0
erreur% = 1
reeturn
end_if
end_if
next c%
next l%
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
col% = col% + 3
end_while
lig% = lig% + 3
end_while
return

' résoudre le tableau chargé
resoudre:
for v%=0 to 81
cursor_hourglass v%
next v%
affic% = checked(504)
xlig% = 0
ld% = 1
cd% = 1
nextlig:
xlig% = xlig% + ld%
xcol% = 0
if cd%<0 then xcol% = 10
nextcol:
xcol% = xcol% + cd%
if xcol%>9 or xcol%<1 then goto nextlig
if xlig%>9 then goto finish
if xlig%<1 then goto inex
if revele%(xlig%,xcol%)=1 then goto nextcol
nextval:
if sudoku%(xlig%,xcol%)<9
sudoku%(xlig%,xcol%) = sudoku%(xlig%,xcol%) + 1
if affic%=1 then text (xlig%-1)*9+xcol%,str$(sudoku%(xlig%,xcol%))
gosub tester
else
erreur% = 1
end_if
if erreur%=1
if sudoku%(xlig%,xcol%)<9 then goto nextval
sudoku%(xlig%,xcol%) = 0
if affic%=1 then text (xlig%-1)*9+xcol%,""
if xcol%>1
cd% = -1
ld% = -1
goto nextcol
end_if
xcol% = 9
if xlig%>1
cd% = -1
ld% = -1
goto nextlig
end_if
inex:
for v%=0 to 81
cursor_default v%
next v%
i% = message_error_ok("Cette grille n'a pas de solution !")
return
end_if
ld% = 1
cd% = 1
goto nextcol
finish:
if affic%=0
for lig%=1 to 9
for col%=1 to 9
if revele%(lig%,col%)=0
text (lig%-1)*9+col%,str$(sudoku%(lig%,col%))
end_if
next col%
next lig%
end_if
for v%=0 to 81
cursor_default v%
next v%
message "La solution de la grille est trouvée !"
return

' tester la validité de la grille
tester:
erreur% = 0
' for lig%=1 to 9 : ' test des lignes
lig% = xlig% : ' test de la ligne active
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
' next lig%
' for col%=1 to 9 : ' test des colonnes
col% = xcol% : ' test de la colonne active
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
' next col%
lig% = xlig% : ' test du carré actif
if lig%>6 then lig%=7
if lig%>3 and lig%<7 then lig%=4
if lig%<4 then lig%=1
col% = xcol%
if col%>6 then col%=7
if col%>3 and col%<7 then col%=4
if col%<4 then col%=1
lb% = 0
cb% = 0
for v%=1 to 9
flags%(v%) = 0
next v%
while lb%<3
v% = sudoku%(lig%+lb%,col%+cb%)
if v%>0
if flags%(v%)=1
erreur% = 1
return
else
flags%(v%) = 1
end_if
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
return

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Chapeau Klaus ! je n'ai pas encore regardé la logique du programme mais j'ai tout de suite essayé avec une grille 'Défi', et il ~~a trouvé en moins de deux !~~ est en train de mouliner depuis quelques minutes...

J'ai essayé il y a quelque temps de faire un programme de fabrication de grilles de Sudoku, mais je m'y suis cassé les dents, ça générait des grilles souvent insolubles, ou ambiguës. Et du coup, après quelques recherches sur Internet, je me suis aperçu que je n'étais pas le seul, que ce n'était pas évident du tout, du coup j'ai abandonné.

Je ne comprends pas. J'ai réessayé avec une série de grilles. Les chiffres saisies au départ sont affichés en gras et noir, et les chiffres calculés sont en simple épaisseur en bleu. On voit bien que les chiffres en noir ne bougent pas, et que les chiffres en bleu constituent la solution.

Une précision: j'ai oublié de dire qu'après avoir saisi les nombres constituant le problème initial, il faut cliquer sur "Charger". Cela active le bouton "Résoudre" qui construit alors la solution, sans toucher aux données initiales.

Si tu as un problème avec une grille, poste-la-moi sous forme de texte, du style

Code:: - - 6 - 3 - 8 - -
8 - - 7 - 4 - - 2
9 - 7 - - - 6 - 1

- 5 2 - - - 4 8 -
- - - 1 - 9 - - -
6 - - - 5 - - - 3

- 1 - 5 - 8 - 6 -
- - 5 - - - 9 - -
4 9 - - - - - 2 5

Cette grille doit produire le résultat suivant:

Code:: 5 2 6 9 3 1 8 4 7
8 3 1 7 6 4 5 9 2
9 4 7 8 2 5 6 3 1

1 5 2 3 7 6 4 8 9
3 7 4 1 8 9 2 5 6
6 8 9 4 5 2 1 7 3

2 1 3 5 9 8 7 6 4
7 6 5 2 4 3 9 1 8
4 9 8 6 1 7 3 2 5

A tout hasard, voici le source opérationnel à nouveau:

Code:: ' SUDOKU solution

label effacer, charger, resoudre, verif
label nextlig, nextcol, nextval, finish, tester, inex

dim lig%, col%, obj%, v%, erreur%, lb%, cb%, l%, c%, ld%, cd%, xlig%, xcol%, i%, affic%
dim sudoku%(9,9), revele%(9,9), flags%(9)

for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
edit obj%
left obj%,100+col%*30
top obj%,100+lig%*30
width obj%,20
next col%
next lig%

2d_line 120,125,395,125
2d_line 120,395,395,395
2d_line 120,125,120,395
2d_line 395,125,395,395
2d_line 120,215,395,215
2d_line 120,305,395,305
2d_line 215,125,215,395
2d_line 305,125,305,395

button 501
top 501,10
left 501,10
caption 501,"Effacer"
hint 501,"Vider la grille"
on_click 501,effacer

button 502
top 502,10
left 502,100
caption 502,"Charger"
hint 502,"Charger la configuration saisie dans la grille"
on_click 502,charger

button 503
inactive 503
top 503,10
left 503,190
caption 503,"Résoudre"
hint 503,"Résoudre la grille"
on_click 503,resoudre

option 504
top 504,50
left 504,10
caption 504,"Afficher progression"
hint 504,"Afficher l'évolution des nombres calculés"

end

' effacer les tableaux
effacer:
for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
font_color obj%,0,0,0
font_bold_off obj%
text obj%,""
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
next col%
next lig%
inactive 503
return

' charger le tableau
charger:
for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
if text$(obj%)=""
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
font_color obj%,0,0,255
else
if numeric(text$(obj%))=1
v% = val(text$(obj%))
if v%<1 or v%>9
text obj%,"?"
v% = 0
end_if
sudoku%(lig%,col%) = v%
if v%>0
revele%(lig%,col%) = 1
font_bold obj%
text obj%,str$(v%)
end_if
else
text obj%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
end_if
end_if
next col%
next lig%
gosub verif
if erreur%=1
v% = message_error_OK("La grille est incohérente !")
else
active 503
end_if
return

' vérifier la cohérence du tableau
verif:
erreur% = 0
for lig%=1 to 9 : ' test des lignes
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
font_bold_off l%-1)*9+c%
text (lig%-1)*9+col%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
next lig%
for col%=1 to 9 : ' test des colonnes
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
font_bold_off l%-1)*9+c%
text (lig%-1)*9+col%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
next col%
lig% = 1 : ' test des carrés
while lig%<9
col% = 1
while col%<9
lb% = 0
cb% = 0
while lb%<3
if sudoku%(lig%+lb%,col%+cb%)>0
for l%=lig% to lig%+2
for c%=col% to col%+2
if l%<>(lig%+lb%) and c%<>(col%+cb%)
if (sudoku%(l%,c%)>0) and (sudoku%(l%,c%)=sudoku%(lig%+lb%,col%+cb%))
font_bold_off l%-1)*9+c%
text (l%-1)*9+c%,"?"
sudoku%(l%,c%) = 0
revele%(l%,c%) = 0
erreur% = 1
reeturn
end_if
end_if
next c%
next l%
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
col% = col% + 3
end_while
lig% = lig% + 3
end_while
return

' résoudre le tableau chargé
resoudre:
for v%=0 to 81
cursor_hourglass v%
next v%
affic% = checked(504)
xlig% = 0
ld% = 1
cd% = 1
nextlig:
xlig% = xlig% + ld%
xcol% = 0
if cd%<0 then xcol% = 10
nextcol:
xcol% = xcol% + cd%
if xcol%>9 or xcol%<1 then goto nextlig
if xlig%>9 then goto finish
if xlig%<1 then goto inex
if revele%(xlig%,xcol%)=1 then goto nextcol
nextval:
if sudoku%(xlig%,xcol%)<9
sudoku%(xlig%,xcol%) = sudoku%(xlig%,xcol%) + 1
if affic%=1 then text (xlig%-1)*9+xcol%,str$(sudoku%(xlig%,xcol%))
gosub tester
else
erreur% = 1
end_if
if erreur%=1
if sudoku%(xlig%,xcol%)<9 then goto nextval
sudoku%(xlig%,xcol%) = 0
if affic%=1 then text (xlig%-1)*9+xcol%,""
if xcol%>1
cd% = -1
ld% = -1
goto nextcol
end_if
xcol% = 9
if xlig%>1
cd% = -1
ld% = -1
goto nextlig
end_if
inex:
for v%=0 to 81
cursor_default v%
next v%
i% = message_error_ok("Cette grille n'a pas de solution !")
return
end_if
ld% = 1
cd% = 1
goto nextcol
finish:
if affic%=0
for lig%=1 to 9
for col%=1 to 9
if revele%(lig%,col%)=0
text (lig%-1)*9+col%,str$(sudoku%(lig%,col%))
end_if
next col%
next lig%
end_if
for v%=0 to 81
cursor_default v%
next v%
message "La solution de la grille est trouvée !"
return

' tester la validité de la grille
tester:
erreur% = 0
' for lig%=1 to 9 : ' test des lignes
lig% = xlig% : ' test de la ligne active
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
' next lig%
' for col%=1 to 9 : ' test des colonnes
col% = xcol% : ' test de la colonne active
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
' next col%
lig% = xlig% : ' test du carré actif
if lig%>6 then lig%=7
if lig%>3 and lig%<7 then lig%=4
if lig%<4 then lig%=1
col% = xcol%
if col%>6 then col%=7
if col%>3 and col%<7 then col%=4
if col%<4 then col%=1
lb% = 0
cb% = 0
for v%=1 to 9
flags%(v%) = 0
next v%
while lb%<3
v% = sudoku%(lig%+lb%,col%+cb%)
if v%>0
if flags%(v%)=1
erreur% = 1
return
else
flags%(v%) = 1
end_if
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
return

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

J'ai édité pour rectifier ce que j'avais dit, mais ça s'est perdu dans les limbes...
BRAVO, ça a marché, il a fini par trouver (entre 5 et 10 minutes):

sudoku - Résoudre une grille de SUDOKU I1

Je disais d'autre part que:
- ça aurait été plus pratique au moment du chargement de pouvoir se déplacer dans les cases avec les flèches, pour tout faire au clavier, plutôt que d'être obligé de cliquer chaque case avec la souris.
- j'ai validé 'Afficher progression', mais je n'ai rien vu, la solution est apparue d'un seul coup.
Pour ta précision, oui j'avais fait l'erreur au début, il faut bien saisir les chiffres, 'Charger' puis 'Résoudre', et.. attendre.

Mais encore un fois, bravo, programme impeccable !

Encore Edit: ben si, finalement ça affiche bien la progression...

Je suis content que cela marche. Je suis en train de développer une version modifiée pour servir d'aide à la solution. Au chargement, le programme calcule automatiquement la solution, mais ne la dévoile pas. On peut saisir des tentatives, les faire vérifier par le programme, faire afficher la solution globale ou faire ressortir les cases pour lesquelles un nombre particulier serait possible. Tout ceci en processus itératif (mis à part la solution finale, bien sûr), afin de débloquer une grille en pas à pas. C'est pour bientôt...

EDIT

Je regarderai le déplacement par les flèches - cela me paraît judicieux. Pour le moment, on peut utiliser TAB pour passer au champ suivant...

je viens de charger ton prog ...

c'est GENIAL !!!!

moi qui adore les SUDOKU je le compile tout de suite.

cheers

Et voici la suite: une variante avec aide à la solution d'une grille.
EDIT: à 21:01: ajout du bouton "Cacher" pour retirer la solution affichée

Il faut procéder comme suit:
1) saisir la grille de départ
2) cliquer sur "Charger". La grille est vérifiée et mémorisée, et le programme génère la solution de façon cachée. Patience...
3) saisir les nombres présumés dans les cases.

A tout moment, on peut cliquer sur "Vérifier". Une erreur est signalée par un "?" et on peut la corriger, et un nombre correct est pris en compte et verrouillé.

A tout moment, on peut cliquer sur un des numéros à droite, et on a on coloriage de toutes les cellules susceptibles de recevoir ce nombre. On click sur un autre nombre efface le coloriage du nombre précédent et visualise celui du nombre choisi. Un click sur le bouton "X" annule le coloriage.

A tout moment, on peut cliquer sur le bouton "Vider". Cela vide tout ce qui a été saisi, sauf la grille initiale que l'on peut ainsi recommencer.

A tout moment, on peut cliquer sur le bouton "Solution" pour afficher la solution dans la grille. Le bouton "Cacher" permet ensuite de retirer la solution.

A tout moment, on peut cliquer sur le bouton "Effacer", qui produit alors une grille vierge, prêt à recevoir une nouvelle grille de départ.

A vos neurones...

Code:: ' SUDOKU solution

label effacer, charger, resoudre, verif, controler, montrer, vider, possibles, cacher
label poss, poss1, poss2, poss3, poss4, poss5, poss6, poss7, poss8, poss9, poss0
label nextlig, nextcol, nextval, finish, tester, inex

dim lig%, col%, obj%, v%, erreur%, lb%, cb%, l%, c%, ld%, cd%, xlig%, xcol%
dim i%, erreurs%, nombre%
dim sudoku%(9,9), revele%(9,9), solution%(9,9), flags%(9)

for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
edit obj%
left obj%,100+col%*30
top obj%,100+lig%*30
width obj%,20
next col%
next lig%

2d_line 120,125,395,125
2d_line 120,395,395,395
2d_line 120,125,120,395
2d_line 395,125,395,395
2d_line 120,215,395,215
2d_line 120,305,395,305
2d_line 215,125,215,395
2d_line 305,125,305,395

button 501
top 501,10
left 501,10
caption 501,"Effacer"
hint 501,"Effacer totue la grille"
on_click 501,effacer

button 502
top 502,10
left 502,100
caption 502,"Charger"
hint 502,"Charger la configuration saisie dans la grille"
on_click 502,charger

button 503
inactive 503
top 503,10
left 503,190
caption 503,"Solution"
hint 503,"Montrer la solution"
on_click 503,montrer

button 504
inactive 504
top 504,40
left 504,100
caption 504,"Vider"
hint 504,"Vider la grille"
on_click 504,vider

button 505
inactive 505
top 505,10
left 505,280
caption 505,"Contrôler"
hint 505,"Vérifier la validité des nomvres saisis"
on_click 505,controler

button 506
inactive 506
top 506,40
left 506,190
caption 506,"Cacher"
hint 506,"Cacher la solution"
on_click 506,cacher

for i%=1 to 9
button 510+i%
inactive 510+i%
top 510+i%,100+i%*30
left 510+i%,450
width 510+i%,20
hint 510+i%,"Montrer les possibilités pour le nombre "+str$(i%)
caption 510+i%,str$(i%)
next i%
on_click 511,poss1
on_click 512,poss2
on_click 513,poss3
on_click 514,poss4
on_click 515,poss5
on_click 516,poss6
on_click 517,poss7
on_click 518,poss8
on_click 519,poss9
button 520
inactive 520
top 520,400
left 520,450
width 520,20
hint 520,"Effacer les couleurs"
caption 520,"X"
on_click 520,poss0

end

' effacer les tableaux
effacer:
for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
font_color obj%,0,0,0
font_bold_off obj%
text obj%,""
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
solution%(lig%,col%) = 0
active obj%
next col%
next lig%
inactive 503
inactive 504
inactive 505
for i%=511 to 520
inactive i%
next i%
return

' charger le tableau
charger:
for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
if text$(obj%)=""
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
font_color obj%,0,0,255
else
if numeric(text$(obj%))=1
v% = val(text$(obj%))
if v%<1 or v%>9
text obj%,"?"
v% = 0
end_if
sudoku%(lig%,col%) = v%
if v%>0
revele%(lig%,col%) = 1
font_bold obj%
text obj%,str$(v%)
inactive obj%
end_if
else
text obj%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
end_if
end_if
next col%
next lig%
gosub verif
if erreur%=1
v% = message_error_OK("La grille est incohérente !")
else
gosub resoudre
active 503
active 504
active 505
for i%=511 to 520
active i%
next i%
end_if
return

' vérifier la cohérence du tableau
verif:
erreur% = 0
for lig%=1 to 9 : ' test des lignes
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
font_bold_off l%-1)*9+c%
text (lig%-1)*9+col%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
next lig%
for col%=1 to 9 : ' test des colonnes
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
font_bold_off l%-1)*9+c%
text (lig%-1)*9+col%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
next col%
lig% = 1 : ' test des carrés
while lig%<9
col% = 1
while col%<9
lb% = 0
cb% = 0
while lb%<3
if sudoku%(lig%+lb%,col%+cb%)>0
for l%=lig% to lig%+2
for c%=col% to col%+2
if l%<>(lig%+lb%) and c%<>(col%+cb%)
if (sudoku%(l%,c%)>0) and (sudoku%(l%,c%)=sudoku%(lig%+lb%,col%+cb%))
font_bold_off l%-1)*9+c%
text (l%-1)*9+c%,"?"
sudoku%(l%,c%) = 0
revele%(l%,c%) = 0
erreur% = 1
reeturn
end_if
end_if
next c%
next l%
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
col% = col% + 3
end_while
lig% = lig% + 3
end_while
return

' résoudre le tableau chargé
resoudre:
for v%=0 to 81
cursor_hourglass v%
next v%
xlig% = 0
ld% = 1
cd% = 1
nextlig:
xlig% = xlig% + ld%
xcol% = 0
if cd%<0 then xcol% = 10
nextcol:
xcol% = xcol% + cd%
if xcol%>9 or xcol%<1 then goto nextlig
if xlig%>9 then goto finish
if xlig%<1 then goto inex
if revele%(xlig%,xcol%)>0 then goto nextcol
nextval:
if sudoku%(xlig%,xcol%)<9
sudoku%(xlig%,xcol%) = sudoku%(xlig%,xcol%) + 1
' text (xlig%-1)*9+xcol%,str$(sudoku%(xlig%,xcol%))
gosub tester
else
erreur% = 1
end_if
if erreur%=1
if sudoku%(xlig%,xcol%)<9 then goto nextval
sudoku%(xlig%,xcol%) = 0
' text (xlig%-1)*9+xcol%,""
if xcol%>1
cd% = -1
ld% = -1
goto nextcol
end_if
xcol% = 9
if xlig%>1
cd% = -1
ld% = -1
goto nextlig
end_if
inex:
for v%=0 to 81
cursor_default v%
next v%
i% = message_error_ok("Cette grille n'a pas de solution !")
return
end_if
ld% = 1
cd% = 1
goto nextcol
finish:
for lig%=1 to 9
for col%=1 to 9
solution%(lig%,col%) = sudoku%(lig%,col%)
if revele%(lig%,col%)=0 then sudoku%(lig%,col%) = 0
next col%
next lig%
for v%=0 to 81
cursor_default v%
next v%
message "La solution de la grille est trouvée !"
return

' tester la validité de la grille
tester:
erreur% = 0
' for lig%=1 to 9 : ' test des lignes
lig% = xlig% : ' test de la ligne active
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
' next lig%
' for col%=1 to 9 : ' test des colonnes
col% = xcol% : ' test de la colonne active
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
' next col%
lig% = xlig% : ' test du carré actif
if lig%>6 then lig%=7
if lig%>3 and lig%<7 then lig%=4
if lig%<4 then lig%=1
col% = xcol%
if col%>6 then col%=7
if col%>3 and col%<7 then col%=4
if col%<4 then col%=1
lb% = 0
cb% = 0
for v%=1 to 9
flags%(v%) = 0
next v%
while lb%<3
v% = sudoku%(lig%+lb%,col%+cb%)
if v%>0
if flags%(v%)=1
erreur% = 1
return
else
flags%(v%) = 1
end_if
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
return

' contrôler des valeurs saisies
controler:
erreurs% = 0
for xlig%=1 to 9
for xcol%=1 to 9
if revele%(xlig%,xcol%)=0
obj% = (xlig%-1)*9 + xcol%
if text$(obj%)<>""
if numeric(text$(obj%))=1
v% = val(text$(obj%))
if v%<1 or v%>9
text obj%,"?"
erreurs% = erreur% + 1
else
gosub tester
if erreur%=1
text obj%,"?"
erreurs% = erreurs% + 1
else
v% = val(text$(obj%))
if solution%(xlig%,xcol%)=v%
font_bold obj%
text obj%,str$(v%)
sudoku%(xlig%,xcol%) = v%
revele%(xlig%,xcol%) = 2
inactive obj%
else
text obj%,"?"
erreurs% = erreurs% + 1
end_if
end_if
end_if
else
text obj%,"?"
erreurs% = erreurs% + 1
end_if
end_if
end_if
next xcol%
next xlig%
if erreurs%=0
i% = message_information_ok("Il y a "+str$(erreurs%)+ " erreurs !")
else
i% = message_error_ok("Il y a "+str$(erreurs%)+ " erreurs !")
end_if
return

' montrer la solution
montrer:
for lig%=1 to 9
for col%=1 to 9
if revele%(lig%,col%)=0
text (lig%-1)*9 + col%, str$(solution%(lig%,col%))
end_if
next col%
next lig%
active 506
inactive 503
return

' vider la grille des données saisies
vider:
for lig%=1 to 9
for col%=1 to 9
if revele%(lig%,col%)<>1
text (lig%-1)*9 + col%, ""
revele%(lig%,col%) = 0
sudoku%(lig%,col%) = 0
active (lig%-1)*9 + col%
end_if
next col%
next lig%
return

' montrer les possibilités des nombres
poss1:
nombre% = 1
gosub poss
return
poss2:
nombre% = 2
gosub poss
return
poss3:
nombre% = 3
gosub poss
return
poss4:
nombre% = 4
gosub poss
return
poss5:
nombre% = 5
gosub poss
return
poss6:
nombre% = 6
gosub poss
return
poss7:
nombre% = 7
gosub poss
return
poss8:
nombre% = 8
gosub poss
return
poss9:
nombre% = 9
gosub poss
return
poss0:
for xlig%=1 to 9
for xcol%=1 to 9
color (xlig%-1)*9+xcol%,255,255,255
next xcol%
next xlig%
return

poss:
for xlig%=1 to 9
for xcol%=1 to 9
gosub possibles
if erreur%=0
color (xlig%-1)*9+xcol%,242,239,26
else
color (xlig%-1)*9+xcol%,255,255,255
end_if
next xcol%
next xlig%
return

possibles:
erreur% = 0
lig%=xlig% : ' test des lignes
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
if flags%(nombre%)=1
erreur% = 1
return
end_if
col%=xcol% : ' test des colonnes
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
if flags%(nombre%)=1
erreur% = 1
return
end_if
lig% = xlig% : ' test du carré actif
if lig%>6 then lig%=7
if lig%>3 and lig%<7 then lig%=4
if lig%<4 then lig%=1
col% = xcol%
if col%>6 then col%=7
if col%>3 and col%<7 then col%=4
if col%<4 then col%=1
lb% = 0
cb% = 0
for v%=1 to 9
flags%(v%) = 0
next v%
while lb%<3
v% = sudoku%(lig%+lb%,col%+cb%)
if v%>0
if flags%(v%)=1
erreur% = 1
return
else
flags%(v%) = 1
end_if
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
if flags%(nombre%)=1
erreur% = 1
return
end_if
return

' cacher la solution
cacher:
for lig%=1 to 9
for col%=1 to 9
if revele%(lig%,col%)=0 then text (lig%-1)*9+col%,""
next col%
next lig%
active 503
inactive 506
return

Je poste une version amélioré des deux programmes: ils contiennent maintenant des boutons pour charger une grille à partir d'un fichier *.gri et pour sauvegarder la grille actuelle dans un tel fichier. Un tel fichier a 9 lignes et 9 colonnes de texte, contenant les nombres connus et un "x" à la place des vides:

Citation :: xx83x56xx
x5xx2xx8x
xxxx1xxxx
4x78x93x2
6xx4x1xx8
5x96x27x4
xxxx9xxxx
x9xx8xx2x
xx25x38xx

Voici les sources:

SUDOKU solution: trouver la solution de toute grille Sudoku
SUDOKU solution guidée: jouer au Sudoku de façon assistée par ordinateur (SAO)

SUDOKU solution:

Code:: ' SUDOKU solution

label effacer, charger, resoudre, verif, ouvrir, sauver
label nextlig, nextcol, nextval, finish, tester, inex

dim lig%, col%, obj%, v%, erreur%, lb%, cb%, l%, c%, ld%, cd%, xlig%, xcol%
dim i%, affic%, fil$, c$
dim sudoku%(9,9), revele%(9,9), flags%(9)

for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
edit obj%
left obj%,100+col%*30
top obj%,100+lig%*30
width obj%,20
next col%
next lig%

2d_line 120,125,395,125
2d_line 120,395,395,395
2d_line 120,125,120,395
2d_line 395,125,395,395
2d_line 120,215,395,215
2d_line 120,305,395,305
2d_line 215,125,215,395
2d_line 305,125,305,395

button 501
top 501,10
left 501,10
caption 501,"Effacer"
hint 501,"Vider la grille"
on_click 501,effacer

button 502
top 502,10
left 502,100
caption 502,"Charger"
hint 502,"Charger la configuration saisie dans la grille"
on_click 502,charger

button 503
inactive 503
top 503,10
left 503,190
caption 503,"Résoudre"
hint 503,"Résoudre la grille"
on_click 503,resoudre

button 507
top 507,10
left 507,300
caption 507,"Ouvrir"
hint 507,"Ouvrir un fichier grille *.gri"
on_click 507,ouvrir

button 509
inactive 509
top 509,40
left 509,300
caption 509,"Sauver"
hint 509,"Sauver la grille actuelle dans un fichier grille"
on_click 509,sauver

option 504
top 504,50
left 504,10
caption 504,"Afficher progression"
hint 504,"Afficher l'évolution des nombres calculés"

open_dialog 508
filter 508,"Fichier grille|*.gri"
save_dialog 510
filter 510,"Fichier grille|*.gri"

end

' effacer les tableaux
effacer:
for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
font_color obj%,0,0,0
font_bold_off obj%
text obj%,""
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
next col%
next lig%
inactive 503
inactive 509
return

' charger le tableau
charger:
for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
if text$(obj%)=""
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
font_color obj%,0,0,255
else
if numeric(text$(obj%))=1
v% = val(text$(obj%))
if v%<1 or v%>9
text obj%,"?"
v% = 0
end_if
sudoku%(lig%,col%) = v%
if v%>0
revele%(lig%,col%) = 1
font_bold obj%
text obj%,str$(v%)
end_if
else
text obj%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
end_if
end_if
next col%
next lig%
gosub verif
if erreur%=1
v% = message_error_OK("La grille est incohérente !")
else
active 503
active 509
end_if
return

' vérifier la cohérence du tableau
verif:
erreur% = 0
for lig%=1 to 9 : ' test des lignes
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
font_bold_off l%-1)*9+c%
text (lig%-1)*9+col%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
next lig%
for col%=1 to 9 : ' test des colonnes
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
font_bold_off l%-1)*9+c%
text (lig%-1)*9+col%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
next col%
lig% = 1 : ' test des carrés
while lig%<9
col% = 1
while col%<9
lb% = 0
cb% = 0
while lb%<3
if sudoku%(lig%+lb%,col%+cb%)>0
for l%=lig% to lig%+2
for c%=col% to col%+2
if l%<>(lig%+lb%) and c%<>(col%+cb%)
if (sudoku%(l%,c%)>0) and (sudoku%(l%,c%)=sudoku%(lig%+lb%,col%+cb%))
font_bold_off l%-1)*9+c%
text (l%-1)*9+c%,"?"
sudoku%(l%,c%) = 0
revele%(l%,c%) = 0
erreur% = 1
reeturn
end_if
end_if
next c%
next l%
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
col% = col% + 3
end_while
lig% = lig% + 3
end_while
return

' résoudre le tableau chargé
resoudre:
for v%=0 to 81
cursor_hourglass v%
next v%
affic% = checked(504)
xlig% = 0
ld% = 1
cd% = 1
nextlig:
xlig% = xlig% + ld%
xcol% = 0
if cd%<0 then xcol% = 10
nextcol:
xcol% = xcol% + cd%
if xcol%>9 or xcol%<1 then goto nextlig
if xlig%>9 then goto finish
if xlig%<1 then goto inex
if revele%(xlig%,xcol%)=1 then goto nextcol
nextval:
if sudoku%(xlig%,xcol%)<9
sudoku%(xlig%,xcol%) = sudoku%(xlig%,xcol%) + 1
if affic%=1 then text (xlig%-1)*9+xcol%,str$(sudoku%(xlig%,xcol%))
gosub tester
else
erreur% = 1
end_if
if erreur%=1
if sudoku%(xlig%,xcol%)<9 then goto nextval
sudoku%(xlig%,xcol%) = 0
if affic%=1 then text (xlig%-1)*9+xcol%,""
if xcol%>1
cd% = -1
ld% = -1
goto nextcol
end_if
xcol% = 9
if xlig%>1
cd% = -1
ld% = -1
goto nextlig
end_if
inex:
for v%=0 to 81
cursor_default v%
next v%
i% = message_error_ok("Cette grille n'a pas de solution !")
return
end_if
ld% = 1
cd% = 1
goto nextcol
finish:
if affic%=0
for lig%=1 to 9
for col%=1 to 9
if revele%(lig%,col%)=0
text (lig%-1)*9+col%,str$(sudoku%(lig%,col%))
end_if
next col%
next lig%
end_if
for v%=0 to 81
cursor_default v%
next v%
message "La solution de la grille est trouvée !"
return

' tester la validité de la grille
tester:
erreur% = 0
' for lig%=1 to 9 : ' test des lignes
lig% = xlig% : ' test de la ligne active
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
' next lig%
' for col%=1 to 9 : ' test des colonnes
col% = xcol% : ' test de la colonne active
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
' next col%
lig% = xlig% : ' test du carré actif
if lig%>6 then lig%=7
if lig%>3 and lig%<7 then lig%=4
if lig%<4 then lig%=1
col% = xcol%
if col%>6 then col%=7
if col%>3 and col%<7 then col%=4
if col%<4 then col%=1
lb% = 0
cb% = 0
for v%=1 to 9
flags%(v%) = 0
next v%
while lb%<3
v% = sudoku%(lig%+lb%,col%+cb%)
if v%>0
if flags%(v%)=1
erreur% = 1
return
else
flags%(v%) = 1
end_if
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
return

' ouvrir un fichier grille
ouvrir:
fil$ = file_name$(508)
if fil$<>"_"
gosub effacer
file_open_read 2,fil$
for lig%=1 to 9
file_readln 2,fil$
for col%=1 to 9
c$ = mid$(fil$,col%,1)
if numeric(c$)=1
v% = val(c$)
if v%>0 and v%<10 then text (lig%-1)*9+col%,c$
end_if
next col%
next lig%
file_close 2
gosub charger
end_if
return

' sauver la grille actuelle dans un fichier grille
sauver:
fil$ = file_name$(510)
if fil$<>"_"
file_open_write 2,fil$
for lig%=1 to 9
fil$ = ""
for col%=1 to 9
if revele%(lig%,col%)>0
fil$ = fil$ + str$(sudoku%(lig%,col%))
else
fil$ = fil$ + "x"
end_if
next col%
file_writeln 2,fil$
next lig%
file_close 2
end_if
return

SUDOKU solution guidée:

Code:: ' SUDOKU solution

label effacer, charger, resoudre, verif, controler, montrer, vider, possibles, cacher
label ouvrir, sauver
label poss, poss1, poss2, poss3, poss4, poss5, poss6, poss7, poss8, poss9, poss0
label nextlig, nextcol, nextval, finish, tester, inex

dim lig%, col%, obj%, v%, erreur%, lb%, cb%, l%, c%, ld%, cd%, xlig%, xcol%
dim i%, erreurs%, nombre%, fil$, c$
dim sudoku%(9,9), revele%(9,9), solution%(9,9), flags%(9)

for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
edit obj%
left obj%,100+col%*30
top obj%,100+lig%*30
width obj%,20
next col%
next lig%

2d_line 120,125,395,125
2d_line 120,395,395,395
2d_line 120,125,120,395
2d_line 395,125,395,395
2d_line 120,215,395,215
2d_line 120,305,395,305
2d_line 215,125,215,395
2d_line 305,125,305,395

button 501
top 501,10
left 501,10
caption 501,"Effacer"
hint 501,"Effacer totue la grille"
on_click 501,effacer

button 502
top 502,10
left 502,100
caption 502,"Charger"
hint 502,"Charger la configuration saisie dans la grille"
on_click 502,charger

button 503
inactive 503
top 503,10
left 503,190
caption 503,"Solution"
hint 503,"Montrer la solution"
on_click 503,montrer

button 504
inactive 504
top 504,40
left 504,100
caption 504,"Vider"
hint 504,"Vider la grille"
on_click 504,vider

button 505
inactive 505
top 505,10
left 505,280
caption 505,"Contrôler"
hint 505,"Vérifier la validité des nomvres saisis"
on_click 505,controler

button 506
inactive 506
top 506,40
left 506,190
caption 506,"Cacher"
hint 506,"Cacher la solution"
on_click 506,cacher

button 507
top 507,10
left 507,400
caption 507,"Ouvrir"
hint 507,"Ouvrir un fichier grille *.gri"
on_click 507,ouvrir

button 509
inactive 509
top 509,40
left 509,400
caption 509,"Sauver"
hint 509,"Sauver la grille actuelle dans un fichier grille"
on_click 509,sauver

open_dialog 508
filter 508,"Fichier grille|*.gri"
save_dialog 510
filter 510,"Fichier grille|*.gri"

for i%=1 to 9
button 510+i%
inactive 510+i%
top 510+i%,100+i%*30
left 510+i%,450
width 510+i%,20
hint 510+i%,"Montrer les possibilités pour le nombre "+str$(i%)
caption 510+i%,str$(i%)
next i%
on_click 511,poss1
on_click 512,poss2
on_click 513,poss3
on_click 514,poss4
on_click 515,poss5
on_click 516,poss6
on_click 517,poss7
on_click 518,poss8
on_click 519,poss9
button 520
inactive 520
top 520,400
left 520,450
width 520,20
hint 520,"Effacer les couleurs"
caption 520,"X"
on_click 520,poss0

end

' effacer les tableaux
effacer:
for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
font_color obj%,0,0,0
font_bold_off obj%
text obj%,""
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
solution%(lig%,col%) = 0
active obj%
next col%
next lig%
inactive 503
inactive 504
inactive 505
inactive 509
for i%=511 to 520
inactive i%
next i%
return

' charger le tableau
charger:
for lig%=1 to 9
for col%=1 to 9
obj% = (lig%-1)*9 + col%
if text$(obj%)=""
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
font_color obj%,0,0,255
else
if numeric(text$(obj%))=1
v% = val(text$(obj%))
if v%<1 or v%>9
text obj%,"?"
v% = 0
end_if
sudoku%(lig%,col%) = v%
if v%>0
revele%(lig%,col%) = 1
font_bold obj%
text obj%,str$(v%)
inactive obj%
end_if
else
text obj%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
end_if
end_if
next col%
next lig%
gosub verif
if erreur%=1
v% = message_error_OK("La grille est incohérente !")
else
gosub resoudre
active 503
active 504
active 505
active 509
for i%=511 to 520
active i%
next i%
end_if
return

' vérifier la cohérence du tableau
verif:
erreur% = 0
for lig%=1 to 9 : ' test des lignes
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
font_bold_off l%-1)*9+c%
text (lig%-1)*9+col%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
next lig%
for col%=1 to 9 : ' test des colonnes
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
font_bold_off l%-1)*9+c%
text (lig%-1)*9+col%,"?"
sudoku%(lig%,col%) = 0
revele%(lig%,col%) = 0
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
next col%
lig% = 1 : ' test des carrés
while lig%<9
col% = 1
while col%<9
lb% = 0
cb% = 0
while lb%<3
if sudoku%(lig%+lb%,col%+cb%)>0
for l%=lig% to lig%+2
for c%=col% to col%+2
if l%<>(lig%+lb%) and c%<>(col%+cb%)
if (sudoku%(l%,c%)>0) and (sudoku%(l%,c%)=sudoku%(lig%+lb%,col%+cb%))
font_bold_off l%-1)*9+c%
text (l%-1)*9+c%,"?"
sudoku%(l%,c%) = 0
revele%(l%,c%) = 0
erreur% = 1
reeturn
end_if
end_if
next c%
next l%
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
col% = col% + 3
end_while
lig% = lig% + 3
end_while
return

' résoudre le tableau chargé
resoudre:
for v%=0 to 81
cursor_hourglass v%
next v%
xlig% = 0
ld% = 1
cd% = 1
nextlig:
xlig% = xlig% + ld%
xcol% = 0
if cd%<0 then xcol% = 10
nextcol:
xcol% = xcol% + cd%
if xcol%>9 or xcol%<1 then goto nextlig
if xlig%>9 then goto finish
if xlig%<1 then goto inex
if revele%(xlig%,xcol%)>0 then goto nextcol
nextval:
if sudoku%(xlig%,xcol%)<9
sudoku%(xlig%,xcol%) = sudoku%(xlig%,xcol%) + 1
' text (xlig%-1)*9+xcol%,str$(sudoku%(xlig%,xcol%))
gosub tester
else
erreur% = 1
end_if
if erreur%=1
if sudoku%(xlig%,xcol%)<9 then goto nextval
sudoku%(xlig%,xcol%) = 0
' text (xlig%-1)*9+xcol%,""
if xcol%>1
cd% = -1
ld% = -1
goto nextcol
end_if
xcol% = 9
if xlig%>1
cd% = -1
ld% = -1
goto nextlig
end_if
inex:
for v%=0 to 81
cursor_default v%
next v%
i% = message_error_ok("Cette grille n'a pas de solution !")
return
end_if
ld% = 1
cd% = 1
goto nextcol
finish:
for lig%=1 to 9
for col%=1 to 9
solution%(lig%,col%) = sudoku%(lig%,col%)
if revele%(lig%,col%)=0 then sudoku%(lig%,col%) = 0
next col%
next lig%
for v%=0 to 81
cursor_default v%
next v%
message "La solution de la grille est trouvée !"
return

' tester la validité de la grille
tester:
erreur% = 0
' for lig%=1 to 9 : ' test des lignes
lig% = xlig% : ' test de la ligne active
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
' next lig%
' for col%=1 to 9 : ' test des colonnes
col% = xcol% : ' test de la colonne active
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
' next col%
lig% = xlig% : ' test du carré actif
if lig%>6 then lig%=7
if lig%>3 and lig%<7 then lig%=4
if lig%<4 then lig%=1
col% = xcol%
if col%>6 then col%=7
if col%>3 and col%<7 then col%=4
if col%<4 then col%=1
lb% = 0
cb% = 0
for v%=1 to 9
flags%(v%) = 0
next v%
while lb%<3
v% = sudoku%(lig%+lb%,col%+cb%)
if v%>0
if flags%(v%)=1
erreur% = 1
return
else
flags%(v%) = 1
end_if
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
return

' contrôler des valeurs saisies
controler:
erreurs% = 0
for xlig%=1 to 9
for xcol%=1 to 9
if revele%(xlig%,xcol%)=0
obj% = (xlig%-1)*9 + xcol%
if text$(obj%)<>""
if numeric(text$(obj%))=1
v% = val(text$(obj%))
if v%<1 or v%>9
text obj%,"?"
erreurs% = erreur% + 1
else
gosub tester
if erreur%=1
text obj%,"?"
erreurs% = erreurs% + 1
else
v% = val(text$(obj%))
if solution%(xlig%,xcol%)=v%
font_bold obj%
text obj%,str$(v%)
sudoku%(xlig%,xcol%) = v%
revele%(xlig%,xcol%) = 2
inactive obj%
else
text obj%,"?"
erreurs% = erreurs% + 1
end_if
end_if
end_if
else
text obj%,"?"
erreurs% = erreurs% + 1
end_if
end_if
end_if
next xcol%
next xlig%
if erreurs%=0
i% = message_information_ok("Il y a "+str$(erreurs%)+ " erreurs !")
else
i% = message_error_ok("Il y a "+str$(erreurs%)+ " erreurs !")
end_if
return

' montrer la solution
montrer:
for lig%=1 to 9
for col%=1 to 9
if revele%(lig%,col%)=0
text (lig%-1)*9 + col%, str$(solution%(lig%,col%))
end_if
next col%
next lig%
active 506
inactive 503
return

' vider la grille des données saisies
vider:
for lig%=1 to 9
for col%=1 to 9
if revele%(lig%,col%)<>1
text (lig%-1)*9 + col%, ""
revele%(lig%,col%) = 0
sudoku%(lig%,col%) = 0
active (lig%-1)*9 + col%
end_if
next col%
next lig%
return

' montrer les possibilités des nombres
poss1:
nombre% = 1
gosub poss
return
poss2:
nombre% = 2
gosub poss
return
poss3:
nombre% = 3
gosub poss
return
poss4:
nombre% = 4
gosub poss
return
poss5:
nombre% = 5
gosub poss
return
poss6:
nombre% = 6
gosub poss
return
poss7:
nombre% = 7
gosub poss
return
poss8:
nombre% = 8
gosub poss
return
poss9:
nombre% = 9
gosub poss
return
poss0:
for xlig%=1 to 9
for xcol%=1 to 9
color (xlig%-1)*9+xcol%,255,255,255
next xcol%
next xlig%
return

poss:
for xlig%=1 to 9
for xcol%=1 to 9
gosub possibles
if erreur%=0
color (xlig%-1)*9+xcol%,242,239,26
else
color (xlig%-1)*9+xcol%,255,255,255
end_if
next xcol%
next xlig%
return

possibles:
erreur% = 0
lig%=xlig% : ' test des lignes
for v%=1 to 9
flags%(v%) = 0
next v%
for col%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next col%
if flags%(nombre%)=1
erreur% = 1
return
end_if
col%=xcol% : ' test des colonnes
for v%=1 to 9
flags%(v%) = 0
next v%
for lig%=1 to 9
if sudoku%(lig%,col%)>0
if flags%(sudoku%(lig%,col%))=1
erreur% = 1
return
else
flags%(sudoku%(lig%,col%)) = 1
end_if
end_if
next lig%
if flags%(nombre%)=1
erreur% = 1
return
end_if
lig% = xlig% : ' test du carré actif
if lig%>6 then lig%=7
if lig%>3 and lig%<7 then lig%=4
if lig%<4 then lig%=1
col% = xcol%
if col%>6 then col%=7
if col%>3 and col%<7 then col%=4
if col%<4 then col%=1
lb% = 0
cb% = 0
for v%=1 to 9
flags%(v%) = 0
next v%
while lb%<3
v% = sudoku%(lig%+lb%,col%+cb%)
if v%>0
if flags%(v%)=1
erreur% = 1
return
else
flags%(v%) = 1
end_if
end_if
cb% = cb% + 1
if cb%=3
lb% = lb% + 1
cb% = 0
end_if
end_while
if flags%(nombre%)=1
erreur% = 1
return
end_if
return

' cacher la solution
cacher:
for lig%=1 to 9
for col%=1 to 9
if revele%(lig%,col%)=0 then text (lig%-1)*9+col%,""
next col%
next lig%
active 503
inactive 506
return

' ouvrir un fichier grille
ouvrir:
fil$ = file_name$(508)
if fil$<>"_"
gosub effacer
file_open_read 2,fil$
for lig%=1 to 9
file_readln 2,fil$
for col%=1 to 9
c$ = mid$(fil$,col%,1)
if numeric(c$)=1
v% = val(c$)
if v%>0 and v%<10 then text (lig%-1)*9+col%,c$
end_if
next col%
next lig%
file_close 2
gosub charger
end_if
return

' sauver la grille actuelle dans un fichier grille
sauver:
fil$ = file_name$(510)
if fil$<>"_"
file_open_write 2,fil$
for lig%=1 to 9
fil$ = ""
for col%=1 to 9
if revele%(lig%,col%)>0
fil$ = fil$ + str$(sudoku%(lig%,col%))
else
fil$ = fil$ + "x"
end_if
next col%
file_writeln 2,fil$
next lig%
file_close 2
end_if
return

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

Trop fort Klaus !
Je teste tout ça tout de suite.

1er programme: résolution automatique, impeccable.

2ème programme: jeu, je charge une grille (Ouvrir) mais après ça boucle quelque part et je n'ai plus la main...
EDIT ah pardon, j'ai compris, le temps d'attente c'est le temps qu'il met à résoudre la grille d'abord (je n'avais pas bien lu), et maintenant c'est à moi de jouer ! il faudrait afficher quelque chose pour faire patienter et rassurer le joueur... parce que ça peut être long et on ne sait pas trop ce qui se passe.

Mais quoiqu'il en soit, c'est vraiment un beau programme, original et bien présenté, et qui marche ! Bravo Klaus !

Ca semble boucler, mais en réalité, il est en train de calculer la solution de la grille, de façon cachée, afin de pouvoir vérifier la validité de la saisie des nombres effectués par la suite. Cette phase, marquée par le sablier sur la form 0, se termine obligatoirement par me message "solution trouvée" ou "grille sans solution". Il suffit de patienter...

Eh bien, mon message c'est croisé avec ton EDIT. Content que cela marche. Amuse-toi bien - c'est le but !

Nombre de messages : 7112 Localisation : 77 Date d'inscription : 29/11/2007

C'est ce que j'éditais, je n'avais pas lu avec assez d'attention ! trop pressé d'en découdre...

J'ai étoffé mon programme SUDOKU solution guidée. J'y ai rajouté la possibilité de voir dans la grille tous les emplacements possibles pour un numéro donné, et de voir dans un carré à droite, tous les numéros possibles pour une cellule dans laquelle on a cliqué. Un click sur un de ces numéros l'installe dans la cellule.

Comme le programme continue de grandir, je le mets à disposition via mon site, rubrique "Panoramic". Le zip à télécharger contient aussi un lisez-moi.txt.

Donc, je clos la discussion ici et ouvre un fil de discussion dédié dans la section "Le site de Klaus" sur la page d'accueil du forum. A bientôt à cet endroit...

Ca y est, c' est noël avant l' heure .

tu vas finir par prendre le surnom de Santa Klaus

méfies toi lol!

Chapeau!!! cheers

Nombre de messages : 100 Date d'inscription : 23/09/2009

Ah là là... c'est fou comment les Panoramiciens aiment se casser la tête! Bravo!!!

Nombre de messages : 2747 Date d'inscription : 13/09/2009

T'as raison, ils sont fous, ces panoramiciens !
lol!

» un p'tit sudoku a resoudre
» SUDOKU
» Sudoku
» Construire et résoudre un puzzle
» Résoudre un puzzle créé par Puzzeliser