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
| PROGRAM Tournoi;
USES Crt, E_Texte;
CONST Njoueur = 40; Nj4 = 4 * Njoueur;
TYPE Tab_4NE = ARRAY[0..Nj4] OF Word;
Tab_4E = ARRAY[1..4] OF Word;
Joueur = RECORD Date: Word;
OrdJ: Tab_4E END;
Tab_T = ARRAY[0..Njoueur - 1] OF Tab_4E;
Tab_J = ARRAY[0..Njoueur - 1] OF Joueur;
VAR Npart: Word;
ListeN: Tab_4NE;
ListeJ: Tab_J;
ListeT: Tab_T;
PROCEDURE Controle;
CONST C1 = 35; L1 = 5; o = 7;
VAR i: Byte; k: Word;
BEGIN
E(0015); Wt(C1 + 4, L1 - 3, 'Rang Date Ordres du jeu');
FOR k:= 0 TO (Njoueur - 1) DO
BEGIN
E(0012); We(C1, L1 + k, k, o);
E(0009); Write(ListeJ[k].Date:o); E(0014);
WITH ListeJ[k] DO
FOR i:= 1 TO 4 DO Write(OrdJ[i]:o)
END;
A_
END;
PROCEDURE EpurationLn(Ia, Ib, Ic, Id: Word;
VAR N_m: Word; VAR L_n: Tab_4NE);
CONST Jmax = Nj4 - 1;
VAR j, J1, Nm: Word;
BEGIN
J1:= 0; WHILE (L_n[J1]<>Ia) DO Inc(J1);
FOR j:= J1 TO Jmax DO L_n[j]:= L_n[j + 1];
J1:= 0; WHILE (L_n[J1]<>Ib) DO Inc(J1);
FOR j:= J1 TO Jmax DO L_n[j]:= L_n[j + 1];
J1:= 0; WHILE (L_n[J1]<>Ic) DO Inc(J1);
FOR j:= J1 TO Jmax DO L_n[j]:= L_n[j + 1];
J1:= 0; WHILE (L_n[J1]<>Id) DO Inc(J1);
FOR j:= J1 TO Jmax DO L_n[j]:= L_n[j + 1];
Nm:= N_m; N_m:= Nm - 4
END;
PROCEDURE Aff_IdJNmax(W: Tab_4E; Nm: Word);
VAR i: Byte;
BEGIN
E(0011); FOR i:= 1 TO 4 DO Write(W[i]:5);
E(0010); Write(Nm:10)
END;
PROCEDURE Aff_Np(k_: Word);
CONST L1 = 4; o = 5;
BEGIN
IF (k_=1) THEN BEGIN
E(1015); Wt(2, L1 - 2, 'Partie Joueurs');
Write(' Nmax');
END;
E(0013); We(1, L1 + k_, k_, o)
END;
FUNCTION Test4E(w, x, y, z: Word): Bool;
VAR Twxyz, Twyxz, Twzxy: Bool;
BEGIN
Twxyz:= ((w<>x) AND (y<>z));
Twyxz:= ((w<>y) AND (x<>z));
Twzxy:= ((w<>z) AND (x<>y));
Result:= Twxyz AND (Twyxz AND Twzxy)
END;
PROCEDURE Enumeration(Np, DateT: Word;
VAR L_j: Tab_J; VAR L_t: Tab_T);
VAR i: Byte;
a, b, c, d, D10, k, Kmax, La, Lb, Lc, Ld, m, Nmax,
Ord1, Ord2, Ord3, Ord4, Rng1, Rng2, Rng3, Rng4: Word;
Tord, Trng: Bool;
BEGIN
Kmax:= Np; IF (Kmax>=Njoueur) THEN Kmax:= Njoueur - 1;
RandSeed:= 1333000777; D10:= 10 * DateT; Nmax:= Nj4;
k:= 0;
REPEAT
Inc(k); Aff_Np(k);
REPEAT
a:= Random(Nmax); La:= ListeN[a]; Rng1:= La DIV 4;
Ord1:= La MOD 4; Inc(Ord1);
b:= Random(Nmax); Lb:= ListeN[b]; Rng2:= Lb DIV 4;
Ord2:= Lb MOD 4; Inc(Ord2);
c:= Random(Nmax); Lc:= ListeN[c]; Rng3:= Lc DIV 4;
Ord3:= Lc MOD 4; Inc(Ord3);
d:= Random(Nmax); Ld:= ListeN[d]; Rng4:= Ld DIV 4;
Ord4:= Ld MOD 4; Inc(Ord4);
Trng:= Test4E(Rng1, Rng2, Rng3, Rng4);
Tord:= Test4E(Ord1, Ord2, Ord3, Ord4);
UNTIL (Trng AND Tord);
L_t[k][Ord1]:= Rng1;
Inc(L_j[Rng1].Date, Ord1); L_j[Rng1].OrdJ[Ord1]:= 100 * Ord1;
L_t[k][Ord2]:= Rng2;
Inc(L_j[Rng2].Date, Ord2); L_j[Rng2].OrdJ[Ord2]:= 100 * Ord2;
L_t[k][Ord3]:= Rng3;
Inc(L_j[Rng3].Date, Ord3); L_j[Rng3].OrdJ[Ord3]:= 100 * Ord3;
L_t[k][Ord4]:= Rng4;
Inc(L_j[Rng4].Date, Ord4); L_j[Rng4].OrdJ[Ord4]:= 100 * Ord4;
Aff_IdJNmax(ListeT[k], Nmax);
EpurationLn(La, Lb, Lc, Ld, Nmax, ListeN)
UNTIL (Nmax=0)
END;
PROCEDURE Init_LstT(VAR L_t: Tab_T);
VAR i: Byte; k: Word;
BEGIN
FOR k:= 0 TO (Njoueur - 1) DO
FOR i:= 1 TO 4 DO L_t[k][i]:= 0
END;
PROCEDURE Init_LstJ(VAR L_j: Tab_J);
VAR i: Byte; k: Word;
BEGIN
FOR k:= 0 TO (Njoueur - 1) DO
BEGIN
L_j[k].Date:= 0;
FOR i:= 1 TO 4 DO L_j[k].OrdJ[i]:= i
END
END;
PROCEDURE Init_Lst4N(VAR L_n: Tab_4NE);
VAR k: Word;
BEGIN
FOR k:= 0 TO (Nj4 - 1) DO L_n[k]:= k;
L_n[Nj4]:= 0
END;
BEGIN
Init_Lst4N(ListeN); Init_LstJ(ListeJ); Init_LstT(ListeT);
Enumeration(40, 1, ListeJ, ListeT);
Controle
END. |
Partager