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
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
TLigne = array[1..9] OF integer ;
TMatrice = array[1..9] OF TLigne ;
var
Form1 : TForm1;
Ficsor : Text ;
Matrice, LastMatrice : TMatrice ;
LigneModele, SumCol : TLigne ;
Modele : array[1..126] OF TLigne ;
L2 : array[1..3] OF integer ;
CumulL2, NumL2, IndiceModele, NumSoluce, NbMaxSoluces, L, C : integer ;
implementation
{$R *.DFM}
Procedure AjouterModele ;
Var Col : Integer ;
Begin
IndiceModele := IndiceModele + 1 ;
Modele[IndiceModele] := LigneModele ;
Writeln('Modele n° ', IndiceModele) ;
For Col := 1 to 9 do Write(LigneModele[Col]) ;
Writeln ;
End ; {de Afficher}
Procedure GenererModeles(pos, restant : integer) ;
Var i : integer ;
Begin
if restant = 0
then
begin
for i := pos to 9 do LigneModele [i] := 0 ;
AjouterModele ;
end
else
begin
if pos + restant = 10
then
begin
for i := pos to 9 do LigneModele [i] := 1 ;
AjouterModele ;
end
else
begin
{Génération des modèles avec 1 en position pos -
on commence par 1 pour avoir l'ordre lexicographique descendant}
LigneModele [pos] := 1 ;
GenererModeles(pos+1,restant-1) ;
{Génération des modèles avec 0 en position pos}
LigneModele [pos] := 0 ;
GenererModeles(pos+1,restant) ;
end
end ;
End ; {de GenererModeles}
Procedure Afficher ;
Var Lig, Col : integer ;
Begin
Inc (NumSoluce) ;
If (NumSoluce > NbMaxSoluces) and (NbMaxSoluces <> 0)
Then
begin
Write ('Nombre de solution maxi atteint ') ;
Writeln (NumSoluce, ' / ', NbMaxSoluces) ;
Readln ;
Halt(1) ;
end ;
LastMatrice := Matrice ;
Writeln (Ficsor) ;
Writeln (FicSor,'Solution n° ', NumSoluce, ' :') ;
For Lig := 1 to 9 do
begin
For Col := 1 to 9 do Write(Ficsor, Matrice[Lig,Col]) ;
Writeln (Ficsor) ;
end ;
End ; {de Afficher}
{Ajoute Modele[NumModele] en ligne NumLigne de Matrice
et incrémente les cumuls par colonne correspondant}
Procedure AjouterLigne(NumLigne, NumModele : integer) ;
Var
Col : integer ;
Begin
Matrice[Numligne] := Modele[NumModele] ;
For Col := 1 to 9 do
SumCol [Col] := SumCol [Col] + Modele[NumModele,Col] ;
End ; {de AjouterLigne}
{Décrémente les cumuls par colonne correspondant à la ligne à supprimer
(on ne la supprime pas physiquement)}
Procedure RetirerLigne(Lig : integer) ;
Var
Col : integer ;
Begin
For Col := 1 to 9 do
SumCol [Col] := SumCol [Col] - Matrice[Lig, Col] ;
End ; {de RetirerLigne}
Function ControleContraintes(NumLigne : integer) : boolean ;
Var Lig, Col, CumulLigne, NbL1, NbLn : integer ;
Res, Encore : boolean ;
Begin
Res := true ;
CumulLigne := Matrice[NumLigne,2] +
Matrice[NumLigne,3] +
Matrice[NumLigne,4] +
Matrice[NumLigne,5] ;
{Règle 3 étendue}
If CumulLigne > CumulL2
Then Res := false
Else
{Boucle de contrôle des cumuls de colonnes, sauf la 1ère qui par
construction (Règle 2) est forcément OK}
begin
{Inutile de faire ces contrôles avant la ligne 5}
If Numligne > 4
Then
begin
Col := 2 ;
While Res And (Col <= 9) Do
begin
{Plus de 5 '1' dans une colonne}
If SumCol[Col] > 5 Then Res := False ;
{Plus assez de ligne à créer pour avoir 5 '1' dans une colonne}
If SumCol[Col] < NumLigne - 4 Then Res := False ;
Inc(Col) ;
end ;
end ;
end ;
{Règle 5 (dédoublonnage) : Le plus grand nombre de lignes égales doit
correspondre aux nombre de lignes de type L1 (=111110000).
Dans le cas contraire, on pourrait par permutations obtenir une solution
plus grande.
On ne contrôle que la derniere ligne, puisque les précédentes l'ont déjà été.}
If Res
Then
begin
{Calcul nb de lignes L1}
Lig := 1 ;
NbL1 := 0 ;
Encore := true ;
While Encore do
If Lig > Numligne Then Encore := False
Else
begin
Col := 1 ;
While Encore And (Col <= 9) do
If Matrice[Lig,Col] <> Matrice[1,Col]
Then Encore := False
Else Inc(Col) ;
If Encore
Then Inc(NbL1) ;
Inc (Lig) ;
end;
{Calcul nombre de lignes NumLigne}
Lig := NumLigne ;
NbLn := 0 ;
Encore := true ;
While Encore do
If Lig < 1 Then Encore := False
Else
begin
Col := 1 ;
While Encore And (Col <= 9) do
If Matrice[Lig,Col] <> Matrice[NumLigne,Col]
Then Encore := False
Else Inc(Col) ;
If Encore
Then Inc(NbLn) ;
Dec (Lig) ;
end;
If NbLn > NbL1 Then Res := False ;
end ;
ControleContraintes := Res ;
End ; {de ControleContraintes}
Procedure Explorer (NumLigne, NumModele : integer) ;
Var NumDeb, NumFin, i : integer ;
Begin
If ControleContraintes(NumLigne)
Then
If NumLigne = 9
Then Afficher
Else
begin
{Règle 2}
If (NumLigne > 4) And (NumModele < 71)
Then NumDeb := 71
Else NumDeb := NumModele ;
If NumDeb < 71
Then NumFin := 70
Else NumFin := 126 ;
For i := NumDeb to NumFin Do
Begin
{Ajout à la ligne i du modèle en ligne (NumLigne + 1) de la matrice
On incrémente aussi les totaux de colonnes}
AjouterLigne (NumLigne + 1, i) ;
Explorer (NumLigne + 1, i) ;
{Retrait de la ligne (NumLigne + 1) de la matrice (il s'agit de décrémenter les totaux par colonne)}
RetirerLigne (NumLigne + 1) ;
End ; {du For}
End ; {Du cas NumLigne <> 9}
{Si ControleContraintes retourne faux, inutile d'aller + loin dans cette branche}
End ;
Begin
{Ouverture du fichier de sortie}
AssignFile(FicSor, 'D:\TestsDelphi\SolucesMougel-01.txt') ;
Rewrite(Ficsor) ;
{Génération des 126 modèles de lignes dans l'ordre lexicographique descendant}
IndiceModele := 0 ;
GenererModeles(1,5) ;
{Règle 1}
AjouterLigne(1,1) ;
{Stockage des numero de modele des lignes 2 possibles - cf. Règle 4}
L2[1] := 1;
L2[2] := 2;
L2[3] := 6;
{Demande du nombre maxi de solutions}
Write('Combien de solutions maximums ?') ;
Readln (NbMaxSoluces) ;
{Règle 4}
For NumL2 := 1 to 3 Do
Begin
AjouterLigne(2,L2[NumL2]) ;
CumulL2 := Matrice[2,2] + Matrice[2,3] + Matrice[2,4] + Matrice[2,5] ;
Explorer(2,L2[NumL2]);
RetirerLigne(2) ;
End ;
{Fermeture du fichier de sortie}
Writeln ('Fin des solutions') ;
Writeln ('Dernière solution obtenue : (N°', NumSoluce, ')') ;
For L := 1 to 9 do
begin
For C := 1 to 9 do Write(LastMatrice[L,C]) ;
Writeln ;
end ;
Readln ;
End. |
Envoyé par fremen167
Répondre avec citation
)
.
)
).
Partager