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 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
TLigne = array[1..9] OF integer ;
TMatrice = array[1..9] OF TLigne ;
var
Form1 : TForm1;
Ficsor : Text ;
Matrice, LastMatrice : TMatrice ;
LigneModele, SumCol, CumulLigne : TLigne ;
Modele : array[1..126] OF TLigne ;
L2 : array[1..3] OF integer ;
NumL2, IndiceModele, NumSoluce, NbMaxSoluces, L, C, Diviseur : integer ;
Poids, Fact9Carre : comp ;
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 Fichier : Text) ;
Var Lig, Col : integer ;
Begin
If (NumSoluce > NbMaxSoluces) and (NbMaxSoluces <> 0)
Then
begin
Write ('Nombre de solution maxi atteint ') ;
Writeln (NumSoluce, ' / ', NbMaxSoluces) ;
Readln ;
Halt(1) ;
end ;
LastMatrice := Matrice ;
Writeln (Fichier) ;
Writeln (Fichier,'Solution n° ', NumSoluce, ' :') ;
Writeln (Fichier,'Diviseur = ', Diviseur) ;
For Lig := 1 to 9 do
begin
For Col := 1 to 9 do Write(Fichier, Matrice[Lig,Col]) ;
Writeln (Fichier) ;
end ;
End ; {de Afficher}
{Ajoute Modele[NumModele] en ligne NumLigne de Matrice, calcul le nombre
de 1 dans les colonnes 1 à 5 de la ligne (CumulLigne[i])
et incrémente les cumuls par colonne correspondant}
Procedure AjouterLigne(NumLigne, NumModele : integer) ;
Var
Col : integer ;
Begin
Matrice[Numligne] := Modele[NumModele] ;
CumulLigne[NumLigne] := Matrice[NumLigne,1] +
Matrice[NumLigne,2] +
Matrice[NumLigne,3] +
Matrice[NumLigne,4] +
Matrice[NumLigne,5] ;
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, NbL1, NbLn, LgPref : integer ;
Res, Encore : boolean ;
Begin
Res := true ;
{Règle 3 étendue++}
If CumulLigne[NumLigne] > CumulLigne[NumLigne-1]
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 4 étendue : Si une ligne Li contient la séquence '01' en colonne 6-7,
ou 7-8, ou 8-9, alors on ne peut pas avoir dans les mêmes colonnes des
lignes au dessus uniquement des couples '00' ou '11'. En pratique, on
recherche '10' au dessus car une ligne qui aurait '01' au dessus devrait
également respecter la règle 4. On ne contrôle pas quand CumulLigne = 5
(car la ligne fini par 4 '0') ou 1 (elle fini par 4 '1').
Cas particulier : la première ligne qui a 1 après la colonne 5 doit avoir :
1..10..0 entre les colonnes 6 et 9 (sinon, on peut permuter)}
If Res
Then
begin
If ((CumulLigne[NumLigne] <> 5) AND (CumulLigne[Numligne] <> 1))
Then
begin
Col := 6 ;
{On se positionne sur la première colonne '0'}
While Matrice [NumLigne,Col] = 1 do Inc(Col) ;
{Le cas particulier}
If (CumulLigne[NumLigne-1] = 5)
Then
begin
{On cherche un 1 après}
While Res and (Col <= 9) do
if Matrice [NumLigne,Col] = 1
then Res := false
else inc(Col) ;
end
{Le cas général}
Else
begin
{On cherche le premier 1 après, mais ce n'est pas forcément un cas
d'erreur}
Encore := true ;
While Encore and (Col <= 9) do
if Matrice [NumLigne,Col] = 1
then Encore := false
else inc(Col) ;
{On a trouvé le 1, on vérifie les colonnes au dessus}
If Col <= 9
Then
begin
Encore := true ;
Lig := NumLigne - 1 ;
While Encore AND (Lig > 1) do
begin
If (Matrice [Lig,Col-1] = 1) AND (Matrice [Lig,Col] = 0)
Then
Encore := false
Else
Dec(Lig) ;
end ; {du while}
If Encore Then Res := false ;
end ;
end ; {du cas général}
end ;
end ; {de règle 4 étendue}
If Res
Then
begin
{Règle 6}
{On commence par compter le nombre de 1 préfixe de ligne précédente}
Col := 1 ;
LgPref := 0 ;
While Matrice[NumLigne-1,Col] = 1 do
begin
Inc (Col) ;
Inc (LgPref) ;
end ;
{Puis on vérifie que jusqu'à cette valeur, la ligne a la forme 1..10..0}
Col := 1 ;
While Matrice [NumLigne,Col] = 1 do Inc(Col) ;
While Res and (Col <= LgPref) do
if Matrice [NumLigne,Col] <> 0
then Res := false
else inc(Col) ;
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 du nombre de lignes = à Matrice[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}
{Calcule le "diviseur" qui permet de calculer le cardinal d'une classe :
cardinal = (9!)^2 / diviseur}
Function CalcDiviseur : integer ;
Var DivLig, DivCol, Facteur, Lig, Col, Col2, Entier : integer ;
Encore, Coltriee, ToutTrie : boolean ;
MatriceTmp : TMatrice ;
Begin
{Calcul du diviseur sur les lignes}
DivLig := 1 ;
Facteur := 1 ;
Lig := 2 ;
While Lig <= 9 do
begin
Encore := true ;
Col := 1 ;
While Encore And (Col <= 9) do
If Matrice[Lig-1,Col] <> Matrice[Lig,Col]
Then Encore := False {On a trouve une différence avec ligne précédente}
Else Inc(Col) ;
If Encore
Then
begin
Facteur := Facteur + 1 ;
DivLig := DivLig * Facteur ;
end
else
Facteur := 1 ;
Inc(Lig) ;
end ;
{Calcul du diviseur sur les colonnes}
{Contrairement aux lignes, les colonnes ne sont pas dans l'ordre lexico
==> on les trie (tri à bulles dans une matrice temporaire)...}
MatriceTmp := Matrice ;
{La première colonne est la plus grande (cf. règle 2)}
Col := 2 ;
Repeat
Col2 := 9 ;
ToutTrie := true ;
Repeat
{Comparaison colonnes Col2 / Col2 -1}
Lig := 1 ;
Encore := true ;
While (Lig <= 9) AND Encore do
If MatriceTmp[Col2,Lig] = MatriceTmp [Col2-1,Lig]
Then Inc(Lig)
else Encore := false ;
If Encore
Then
If MatriceTmp[Col2,Lig] > MatriceTmp [Col2-1,Lig]
Then Coltriee := false
Else Coltriee := true
Else
Coltriee := true ;
If not ColTriee
Then
begin
{Permutation des colonnes Col2 et Col2-1}
Lig := 1 ;
While Lig <= 9 do
begin
Entier := MatriceTmp[Col2,Lig] ;
MatriceTmp[Col2,Lig] := MatriceTmp[Col2-1,Lig] ;
MatriceTmp[Col2-1,Lig] := Entier ;
Inc(Lig) ;
end ;
ToutTrie := false ;
end ;
Dec(Col2)
until (Col2 < Col + 1) ;
Inc(Col)
until (Col > 8) OR ToutTrie ;
{... puis on calcule comme pour les lignes}
DivCol := 1 ;
Facteur := 1 ;
Col := 2 ;
While Col <= 9 do
begin
Encore := true ;
Lig := 1 ;
While Encore And (Lig <= 9) do
If MatriceTmp[Lig,Col-1] <> MatriceTmp[Lig,Col]
Then Encore := False {On a trouve une différence avec ligne précédente}
Else Inc(Lig) ;
If Encore
Then
begin
Facteur := Facteur + 1 ;
DivCol := DivCol * Facteur ;
end
else
Facteur := 1 ;
Inc(Col) ;
end ;
{Diviseur global}
CalcDiviseur := Divlig * DivCol ;
End ;
Procedure Explorer (NumLigne, NumModele : integer) ;
Var NumDeb, NumFin, i : integer ;
Begin
If ControleContraintes(NumLigne)
Then
If NumLigne = 9
Then
begin
Diviseur := CalcDiviseur ;
Poids := Poids + (Fact9Carre / Diviseur) ;
Inc (NumSoluce) ;
Afficher (FicSor) ;
end
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, 'H:\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 numéros de modèle des lignes 2 possibles - cf. Règle 4}
L2[1] := 1;
L2[2] := 2;
L2[3] := 6;
{Factorielle 9}
Fact9Carre := 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2 ;
Fact9Carre := Fact9Carre * Fact9Carre ;
{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]) ;
Explorer(2,L2[NumL2]);
RetirerLigne(2) ;
End ;
{Fermeture du fichier de sortie}
Writeln (FicSor,'Fin des solutions') ;
Writeln (FicSor,'Nombre total de solutions pondéré : ', Poids) ;
Close(Ficsor) ;
Writeln ('Fin des solutions') ;
Writeln ('Dernière solution obtenue : (N°', NumSoluce, ')') ;
Writeln ('Nombre total de solutions pondéré : ', Poids) ;
Matrice := LastMatrice ;
Afficher(Output);
(*For L := 1 to 9 do
begin
For C := 1 to 9 do Write(LastMatrice[L,C]) ;
Writeln ;
end ;*)
Readln ;
Halt (2) ;
End. |
Partager