PROGRAM Formule;

 USES Crt; // E_Texte supprim‚

 {$I Form_Comb_9ch_INC.pas}

 CONST Nch = 9; N_3 = Nch - 3; N_6 = Nch - 6;
       Epsilon = 5E-4; Umin = 1 - Epsilon;  Umax = 1 + Epsilon;
       Nval = 50;

 TYPE TabE = ARRAY[1..Nch] OF Byte;
      LstL = ARRAY[1..Nval] OF TabE;

 CONST Lzero: TabE = (0, 0, 0, 0, 0, 0, 0, 0, 0);
       Lst9E: TabE = (1, 2, 3, 4, 5, 6, 7, 8, 9);

 VAR Na, Nb, Nc, Nd, Ne, Nf, Ng, Nh, Ni: Byte;
     Narr, Nsol: Z_32; Vmin, Vmax: Reel;
     Lst6E, Lst3E, LstMax, LstMin: TabE;
     Mat: LstL;

 PROCEDURE AffL(y: Byte; W_: Reel; L_: TabE);
   VAR k: Byte;
   BEGIN
     E(0010); Wr(29, y, W_, 2018);
     Write('  ');
     FOR k:= 1 TO Nch DO BEGIN
                           IF ((k - 1) MOD 3 = 0) THEN E(0012)
                                                  ELSE E(0015);
                           Write(L_[k]:3)
                         END
   END;

 PROCEDURE Transf(Ka, Kb, Kc, Kd, Ke, Kf, Kg, Kh, Ki: Byte; VAR L_: TabE);
   BEGIN
     L_[1]:= Ka; L_[2]:= Kb; L_[3]:= Kc;
     L_[4]:= Kd; L_[5]:= Ke; L_[6]:= Kf;
     L_[7]:= Kg; L_[8]:= Kh; L_[9]:= Ki
   END;

 PROCEDURE CalcS(Ka, Kb, Kc, Kd, Ke, Kf, Kg, Kh, Ki: Byte; VAR S_: Reel);
   VAR Tuv: Byte; Qabc, Qdef, Qghi, S2q: Reel;
   BEGIN
     Tuv:= 10 * Kb; Inc(Tuv, Kc); Qabc:= Ka / Tuv;
     Tuv:= 10 * Ke; Inc(Tuv, Kf); Qdef:= Kd / Tuv; S2q:= Qabc + Qdef;
     Tuv:= 10 * Kh; Inc(Tuv, Ki); Qghi:= Kg / Tuv; S_:= S2q + Qghi
   END;

 PROCEDURE Resultat(VAR Wmin, Wmax: Reel; Lmin, Lmax: TabE);
   CONST L1 = 13;
   VAR s: Reel;
   BEGIN
     Inc(Narr); E(0014); We(40, 9, Narr, 9);
     CalcS(Na, Nb, Nc, Nd, Ne, Nf, Ng, Nh, Ni, s);
     IF (Wmin>s) THEN BEGIN
                        Wmin:= s;
                        Transf(Na, Nb, Nc, Nd, Ne, Nf, Ng, Nh, Ni, LstMin);
                        AffL(L1 - 1, Vmin, LstMin)
                      END;
     IF (Wmax<s) THEN BEGIN
                        Wmax:= s;
                        Transf(Na, Nb, Nc, Nd, Ne, Nf, Ng, Nh, Ni, LstMax);
                        AffL(L1 + 1, Vmax, LstMax)
                      END;
     IF ((Umin<s) AND (s<Umax)) THEN
       BEGIN
         Inc(Nsol);
         IF (Nsol<=Nval) THEN BEGIN
                                E(0014); We(40, 17, Nsol, 9);
                                Transf(Na, Nb, Nc, Nd, Ne,
                                       Nf, Ng, Nh, Ni, Mat[Nval]);
                                AffL(18 + Nsol, s, Mat[Nval])
                              END
       END
   END;

 PROCEDURE Aff_FHI;
   CONST m = 3;
   VAR c, k: Byte;
   BEGIN
     E(0012); GotoXY(40, 6); Write(Nf:m, Nh:m, Ni:m)
   END;

 PROCEDURE Aff_BCEL(L_: TabE);
   CONST m = 3;
   VAR c, k: Byte;
   BEGIN
     E(0012); GotoXY(40, 4); Write(Nb:m, Nc:m, Ne:m, '  ');
     FOR k:= 1 TO Nch DO BEGIN
                           c:= L_[k];
                           IF (c=0) THEN E(0009) ELSE E(0010);
                           Write(c:m)
                         END
   END;

 PROCEDURE Aff_ADGL(L_: TabE);
   CONST m = 3;
   VAR c, k: Byte;
   BEGIN
     E(0012); GotoXY(40, 2); Write(Na:m, Nd:m, Ng:m, '  ');
     FOR k:= 1 TO Nch DO BEGIN
                           c:= L_[k];
                           IF (c=0) THEN E(0009) ELSE E(0010);
                           Write(Lst6E[k]:m)
                         END
   END;

 PROCEDURE InitL(Xu, Xv, Xw, Xm: Byte; L_1: TabE; VAR L_2: TabE);
   VAR i, j, k: Byte; Liste: TabE;
   BEGIN
     k:= 0; Liste:= Lzero;
     FOR i:= 1 TO Xm DO
       BEGIN
         j:= L_1[i];
         IF (j<>Xu) AND ((j<>Xv) AND (j<>Xw)) THEN
           BEGIN
             Inc(k); Liste[k]:= j
           END
       END;
     L_2:= Liste
   END;

 PROCEDURE EnumFHI(VAR Vf, Vh, Vi: Byte; List1: TabE);
   VAR i, j, k, u, v, w: Byte;
   BEGIN
     FOR i:= 1 TO N_6 DO
       FOR j:= 1 TO N_6 DO
         IF (i<>j) THEN
           FOR k:= 1 TO N_6 DO
             IF ((k<>i) AND (k<>j)) THEN
               BEGIN
                 Vf:= List1[i]; Vh:= List1[j]; Vi:= List1[k];
                 Aff_FHI; Resultat(Vmin, Vmax, LstMin, LstMax)
               END
  END;

 PROCEDURE EnumBCE(VAR Vb, Vc, Ve: Byte; List1: TabE);
   VAR i, j, k, u, v, w: Byte;
   BEGIN
     FOR i:= 1 TO N_3 DO
       FOR j:= 1 TO N_3 DO
         IF (i<>j) THEN
           FOR k:= 1 TO N_3 DO
             IF ((k<>i) AND (k<>j)) THEN
               BEGIN
                 Vb:= List1[i]; Vc:= List1[j]; Ve:= List1[k];
                 InitL(Vb, Vc, Ve, N_3, Lst6E, Lst3E);
                 Aff_BCEL(Lst3E);
                 EnumFHI(Nf, Nh, Ni, Lst3E)
               END
  END;


 PROCEDURE EnumADG(VAR Va, Vd, Vg: Byte);
   VAR Ka, Kd, Kg: Byte;
   BEGIN
     FOR Ka:= 1 TO (Nch - 2) DO
       FOR Kd:= (Ka + 1) TO (Nch - 1) DO
         FOR Kg:= (Kd + 1) TO Nch DO
           BEGIN
             Va:= Ka; Vd:= Kd; Vg:= Kg;
             InitL(Na, Nd, Ng, Nch, Lst9E, Lst6E);
             Aff_ADGL(Lst6E);
             EnumBCE(Nb, Nc, Ne, Lst6E);
           END
   END;

 PROCEDURE InitNV(VAR Na_, Ns_: Z_32; VAR Wmin, Wmax: Reel);
   BEGIN
     Na_:= 0;    Ns_:= 0;
     Wmin:= 2.0; Wmax:= 0.0
   END;

 PROCEDURE AffT;
   CONST C1 = 2; L1 = 4; L2 = 13; L3 = 17; O = 'Valeur des 3 indices: ';
   BEGIN
     E(1015);
     Wt(C1, L1 - 2, O + '(Na, Nd, Ng) = ');
     Wt(C1, L1    , O + '(Nb, Nc, Ne) = ');
     Wt(C1, L1 + 2, O + '(Nf, Nh, Ni) = ');
     Wt(C1, L2 - 1, 'Valeur minimale:    Vmin = ');
     Wt(C1, L2 + 1, 'Valeur maximale:    Vmax = ');

     E(0009); Wt(C1, 9, 'Nombre d''arrangements:        Narr = ');
     Wt(C1, L3, 'Nombre de solutions:          Nsol = ');
     E(0011); Wt(53, L3, 'Epsilon = '); Write(Epsilon:9)
   END;

 BEGIN
   AffT; InitNV(Narr, Nsol, Vmin, Vmax);
   EnumADG(Na, Nd, Ng); ReadLn
 END.

HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH