program network;{Raschet PP dlya multisirvisnoi seti}
uses crt;
const L=11;
      N=4;
      delta=1;
      d_beta=0.01;
      e=0.00001;
      poteri=0.05;
      Lamda: array [1..N] of integer = (1,1,1,1);
          M: array [1..N] of integer = (1,1,1,1);
      b: array [1..N] of integer = (3,2,3,5);
type  masL = array [1..L] of integer;
var
    i,j,c,s,k: integer;
    D: array [1..L,1..N] of integer;
    Md: masL;
    a,r,PR: array [1..N] of real;
    v,vv,beta,delt,Er: array [1..L] of real;
    resalt: byte;
    max,P,sc,r1,r2: real;
    outfile: text;

function sum(l7:integer): real;
    var j7,r7: integer;
        sun: real;
    begin
       sun:=0;
       for j7:=1 to N do if D[l7,j7]<>0 then
                 begin
                   sun:=sun+a[j7]*b[j7]*D[l7,j7]*PR[j7];
                 end;
       sum:=sun;
    end;
function fact(z:real): real;
    var  fact7: real;
         z7:Longint;
    begin
        fact7:=1;
        z7:=0;
        while z > z7 do
                    begin
                       z7:=z7+1;
                       fact7:=fact7*z7;
                    end;
        fact:=fact7;
    end;

BEGIN
 clrscr;
 Assign(outfile, 'C:\DATAFILE.CSV');
 rewrite(outfile);
 for i:=1 to L do Md[i]:=1;
 for i:=1 to L do
               for j:=1 to N do D[i,j]:=0;
D[1,1]:=2;D[3,1]:=2;D[5,1]:=1;D[10,1]:=1;
D[2,2]:=3;D[7,2]:=2;D[8,2]:=1;
D[4,3]:=1;D[9,3]:=1;D[11,3]:=1;
D[6,4]:=1;
{D[1,1]:=1;D[2,1]:=1; D[3,1]:=1;D[4,1]:=1;D[5,1]:=1;D[6,1]:=1;D[7,1]:=1;D[8,1]:=1;D[9,1]:=1;D[10,1]:=1;D[11,1]:=1;
D[1,2]:=1;D[2,2]:=1; D[3,2]:=1;D[4,2]:=1;D[5,2]:=1;D[6,2]:=1;D[7,2]:=1;D[8,2]:=1;D[9,2]:=1;D[10,2]:=1;D[11,2]:=1;
D[1,3]:=1;D[2,3]:=1; D[3,3]:=1;D[4,3]:=1;D[5,3]:=1;D[6,3]:=1;D[7,3]:=1;D[8,3]:=1;D[9,3]:=1;D[10,3]:=1;D[11,3]:=1;
D[1,4]:=1;D[2,4]:=1; D[3,4]:=1;D[4,4]:=1;D[5,4]:=1;D[6,4]:=1;D[7,4]:=1;D[8,4]:=1;D[9,4]:=1;D[10,4]:=1;D[11,4]:=1;
D[1,5]:=1;D[2,5]:=1; D[3,5]:=1;D[4,5]:=1;D[5,5]:=1;D[6,5]:=1;D[7,5]:=1;D[8,5]:=1;D[9,5]:=1;D[10,5]:=1;D[11,5]:=1;
D[1,6]:=1;D[2,6]:=1; D[3,6]:=1;D[4,6]:=1;D[5,6]:=1;D[6,6]:=1;D[7,6]:=1;D[8,6]:=1;D[9,6]:=1;D[10,6]:=1;D[11,6]:=1;
D[1,7]:=1;D[2,7]:=1; D[3,7]:=1;D[4,7]:=1;D[5,7]:=1;D[6,7]:=1;D[7,7]:=1;D[8,7]:=1;D[9,7]:=1;D[10,7]:=1;D[11,7]:=1;
D[1,8]:=1;D[2,8]:=1; D[3,8]:=1;D[4,8]:=1;D[5,8]:=1;D[6,8]:=1;D[7,8]:=1;D[8,8]:=1;D[9,8]:=1;D[10,8]:=1;D[11,8]:=1;
D[1,9]:=1;D[2,9]:=1; D[3,9]:=1;D[4,9]:=1;D[5,9]:=1;D[6,9]:=1;D[7,9]:=1;D[8,9]:=1;D[9,9]:=1;D[10,9]:=1;D[11,9]:=1;
D[1,10]:=1;D[2,10]:=1; D[3,10]:=1;D[4,10]:=1;D[5,10]:=1;D[6,10]:=1;D[7,10]:=1;D[8,10]:=1;D[9,10]:=1;D[10,10]:=1;D[11,10]:=1;
D[1,11]:=1;D[2,11]:=1; D[3,11]:=1;D[4,11]:=1;D[5,11]:=1;D[6,11]:=1;D[7,11]:=1;D[8,11]:=1;D[9,11]:=1;D[10,11]:=1;D[11,11]:=1;
D[1,12]:=1;D[2,12]:=1; D[3,12]:=1;D[4,12]:=1;D[5,12]:=1;D[6,12]:=1;D[7,12]:=1;D[8,12]:=1;D[9,12]:=1;D[10,12]:=1;D[11,12]:=1;
D[1,13]:=1;D[2,13]:=1; D[3,13]:=1;D[4,13]:=1;D[5,13]:=1;D[6,13]:=1;D[7,13]:=1;D[8,13]:=1;D[9,13]:=1;D[10,13]:=1;D[11,13]:=1;
D[1,14]:=1;D[2,14]:=1; D[3,14]:=1;D[4,14]:=1;D[5,14]:=1;D[6,14]:=1;D[7,14]:=1;D[8,14]:=1;D[9,14]:=1;D[10,14]:=1;D[11,14]:=1;
D[1,15]:=1;D[2,15]:=1; D[3,15]:=1;D[4,15]:=1;D[5,15]:=1;D[6,15]:=1;D[7,15]:=1;D[8,15]:=1;D[9,15]:=1;D[10,15]:=1;D[11,15]:=1;
D[1,16]:=1;D[2,16]:=1; D[3,16]:=1;D[4,16]:=1;D[5,16]:=1;D[6,16]:=1;D[7,16]:=1;D[8,16]:=1;D[9,16]:=1;D[10,16]:=1;D[11,16]:=1; }


 for i:=1 to L do
               begin
                 vv[i]:=0;
                 for j:=1 to N do
                               begin
                                 a[j]:=Lamda[j]/M[j];
                                 vv[i]:=vv[i]+a[j]*b[j]*D[i,j]
                               end;
               end;

 writeln('START, store data to file c:\datafile.doc');
 writeln(outfile, 'SHAG; V1;V2;V3;V4;V5;V6;V7;V8;V9;V10;V11;R1;R2;R3;R4;R5;R6;R7;R8;R;R10;R11;R12;R13;R14;R15;R16');
 for i:=1 to L do write(' V',i,'=',vv[i]:3:1);
 writeln;
 {readln;}

 for i:=1 to L do
               begin
                  Er[i]:=0;
                  v[i]:=0;
               end;
{ vv[1]:=5;vv[2]:=3;vv[3]:=5;vv[4]:=5;vv[5]:=7;vv[6]:=4;}
{ beta[1]:=0.13;beta[2]:=0.06;beta[3]:=0.041;
 beta[4]:=0.021;beta[5]:=0.081;beta[6]:=0.061;}
{ beta[1]:=0.12;beta[2]:=0.03955;beta[3]:=0.05809;
 beta[4]:=0.0796;beta[5]:=0.02993;beta[6]:=0.04864;}
 s:=0;
 resalt:=0;
 repeat
    s:=s+1;
    writeln(outfile);
    write(outfile,s);
    write(' SHAG :',s,'!',#15);

    write(' Shag: ',s,'!');
    writeln;
    writeln;
    for i:=1 to L do write(' ',vv[i]:3:1); { readln;}
   for i:=1 to L do write(outfile,'; ',vv[i]:3:1);
    for i:=1 to L do beta[i]:=d_beta;
    k:=0;
    repeat
         k:=k+1;
         for c:=1 to L do
                  begin
                  for j:=1 to N do
                                begin
                                PR[j]:=1;
                                for i:=1 to L do
                                         if D[i,j]<>0 then PR[j]:=PR[j]*exp(b[j]*ln(1-beta[i]));
                                end;
                  v[c]:= (1/(1-beta[c]))*sum(c);
                  sc:=0;
                  i:=0;
                { writeln;
                  writeln('Zveno=',c);
                  readln;      }
                  r1:=round(vv[c]);
                  r2:=round(v[c]);
                  repeat
                        sc:=sc + exp(i*ln(v[c]))/fact(i);
                      {  write('i=',i,' f=',fact(i),' sc=',sc:1:4);
                         writeln;}
                        i:=i+1;
                  until i>vv[c];
                  Er[c]:=exp(vv[c]*ln(v[c]))/fact(r1)/sc;
                  {writeln('   Er=',Er[c]:1:10,' ');}
                  end;
{         writeln;
         writeln(k,' iteracji');
         for c:=1 to L do write(' v',c,'=',v[c]:2:2,' ');
         writeln;
         writeln;
         for c:=1 to L do writeln(c,') Er=',Er[c]:1:6,' b=',beta[c]:1:6);}
         P:=0;
         for c:=1 to L do begin
                       P:=P + abs((Er[c]-beta[c])/beta[c]);
                       beta[c]:=(Er[c]+beta[c])/2;
                       end;
{         writeln(' P=',P:2:6);}
{         readln;}
    until P < e;
   { writeln;
    writeln(' Vjpolneno ',k,' iteracii');
    writeln;       }
    {for i:=1 to L do write('  b',i,'=',beta[i]:1:6);}
    for k:=1 to N do begin
                     P:=1;
                     for i:=1 to L do
                         if D[i,k]<>0 then P:=P*
                         exp(b[k]*ln(1-beta[i]));
                     r[k]:=1 - P;
                     end;
      writeln;
   { for i:=1 to N do write('  r',i,'=',r[i]:1:4,' ');   writeln; }
     for i:=1 to N do write(outfile,'; ',r[i]:1:4);
    resalt:=0;
    for k:=1 to N do if r[k] < poteri then resalt:=resalt+1;
    if resalt<>N then begin
                      j:=1;
                      max:=beta[j];
                      for i:=1 to L do if beta[i]>max then
                                       begin
                                       max:=beta[i];
                                       j:=i;
                                       end;
                      vv[j]:=vv[j]+delta;
                      end;
    writeln('                        Uvelichivaem V na ',j,' zvene');
  {  readln;  }
 until {s>12}resalt=N;
writeln;
 writeln;
 writeln(' Rezultat - ',s,' rekurrentnjh shagov');
 writeln;
 for i:=1 to L do write(vv[i]:3:1,' ');
 writeln;
 writeln;
 for i:=1 to N do writeln('  r',i,'=',r[i]:1:4,' ');
 writeln;
 writeln(' HAPPY END!');
  writeln(outfile);
  close(outfile);
 readln;
END.