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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
program sudoku9;
const
randomlim = 100;
bouclemax = 10000;
type
Ms = array [1..9, 1..9] of string[1]; // Matrice 9 * 9
Tab = array [1..2*9] of string[1];
// Tab : pour une intersection ligne/colonne de la position courante
// et stockage de toutes les valeurs présentes (ligne + colonne)
Posx = array [1..9] of integer; // table des compteurs colonnes
Sstr = string[1];
var
i, j, bp ,bs: integer; // bp : indic colonne et bs : indic ligne
compt:longint;
ch : Sstr;
trouve, indic ,nb,noway : boolean;
m: Ms;
pos:Posx;
nboucle:longint; // Nombre de tentative
label deb;
procedure affichCont (m :Ms; pos:PosX); // Affichage matrice
var i, j :integer;
begin
for j := 1 to 9 do
begin
for i := 1 to 8 do
write(m[i,j],' ');
writeln(m[9,j],' ');
end;
writeln('---------');
for i := 1 to 8 do
write(pos[i],' ');
writeln(pos[9],' ');
writeln('---------');
end;
procedure init (var m :Ms; var pos:Posx); // Remplissage matrice '*'
var i, j :integer;
begin
for i := 1 to 9 do
begin
for j := 1 to 9 do
m[i,j] := '*';
pos[i]:=0;
end;
end;
function norandom (m:Ms):Sstr;
// si on n'arrive pas à trouver une valeur
// par la fonction random alors on passe en recherche 'manuelle'
var i : integer ;
ch:string[1];
sauveur:boolean;
var t:tab;
begin
sauveur:=false;
For i:=1 to 9 do
t[i] := M[i, bs] ; // Stockage des valeurs lignes
For i:=1 to 9 do
t[9+i] := M[bp, i]; // Ajout des valeurs colonnes
i:=0 ;
while ((i < 9) and (not sauveur)) do
begin
i:=i+1 ;
sauveur:=true;
str(i, ch);
for j:=1 to 2*9 do // nbre de ligne + nbre de colonne
begin
if (t[j] = ch) then
sauveur := false;
end;
end;
if sauveur then
norandom :=ch
else norandom :=''; // Impasse
end;
function box33 (bp:integer;bs:integer;ch:Sstr):boolean;
var i,j,bp1, bp2, bs1, bS2 : integer;
begin
box33:= false;
if bp in [1..3] then
begin
bp1 := 1;bp2 := 3;
end
else if bp in [4..6] then
begin
bp1 := 4;bp2 := 6;
end
else
begin
bp1 := 7;bp2 := 9;
end;
if bs in [1..3] then
begin
bs1 := 1;bs2 := 3;
end
else if bs in [4..6] then
begin
bs1 := 4;bs2 := 6;
end
else
begin
bs1 := 7;bs2 := 9;
end;
for i := bp1 to bp2 do
for j := bs1 to bs2 do
begin
if ch = M[i, j] then box33:= true;
end;
end;
begin
nboucle:=0;
deb:
nboucle:=nboucle+1;
writeln('Nombre essai->',nboucle);
randomize;
init(m,pos);
bp:=0;
noway:=false;
while ((bp < 9) and (not noway)) do
begin
bp:=bp+1;
bs:=0;
while ((bs < 9) and (not noway)) do
begin
bs:=bs+1;
compt:=0;
indic := false;
while ((compt < randomlim) and (not indic)) do
begin
compt:=compt + 1;
str(random(9) + 1, ch);
i:=0;
trouve:=false;
while ((i < bp) and (not trouve)) do
begin
i:=i+1;
if (ch = M[i, bs]) then trouve:=true;
end;
j:=0;
while ((j < bs) and (not trouve)) do
begin
j:=j+1;
if (ch = M[bp, j]) then trouve:=true;
end;
if not trouve then
if box33(bp,bs,ch) then
trouve:=true;
if not trouve then
begin
M[bp, bs] := ch ;
pos[bp] := bs;
indic:=true;
// Ma matrice 9 * 9 est remplie
if ((bp = bs) and (bp = 9)) then
noway:=true;
end;
end;
if (not indic) then
begin
// Le random ne marche pas alors recherche 'manuelle'
ch:=norandom(m);
if ( ch <> '') then
begin
// Recherche 'manuelle' OK
M[bp, bs] := ch ;
pos[bp] := bs;
indic:=true;
end
else
begin
noway:=true;
end;
end;
end;
end;
trouve:=false;
for i:=1 to 9 do
if (pos[i] <> 9) then trouve:=true;
if ((trouve = false) or (nboucle > 10000)) then
begin
if not trouve then
writeln('SUDOKU COMPLETE avec ',nboucle,' ESSAIS et en niveau RANDOM:',randomlim)
else
begin
writeln('SUDOKU INCOMPLETE avec ',nboucle,' ESSAIS et en niveau RANDOM:',randomlim);
writeln('UNLUCKY : Relancer ou changer le nombre d''essais ou niveau random ...');
end;
affichCont(m,pos);
readln;
end
else goto deb;
end. |
