Cod sursa(job #2221379)

Utilizator cristian51090Oanta Cristian cristian51090 Data 13 iulie 2018 21:37:25
Problema Dezastru Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.42 kb
Program P163;
 { Generarea permutărilor }
const nmax=100;
type Permutare=array[1..nmax] of 1..nmax;
var P : Permutare;
 Indicator : boolean;
 i,n,k : integer;
 x : array[1..100] of real;
 aux: real;
 rasp: real;
 f1,f2:text;
procedure GenerarePermutari(var Indicator : boolean);
  label 1;
  var i, j, k, aux : integer;
begin
 { permutarea identică }
 if not Indicator then
    begin
    for i:=1 to n do P[i]:=i;
    Indicator:=true;
    goto 1;
    end;
 { căutarea indicelui i }
 i:=n-1;
 while P[i]>P[i+1] do
    begin
    i:=i-1;
    if i=0 then
       begin
       { un astfel de indice nu mai există }
       Indicator:=false;
       goto 1;
       end; { then }
   end; {while }
 { căutarea indicelui k }
 k:=n;
 while P[i]>P[k] do k:=k-1;
 { interschimbarea P[i] - P[k] }
 aux:=P[i]; P[i]:=P[k]; P[k]:=aux;
 { ordonarea ultimilor (n-i) elemente }
 for j:=1 to (n-i) div 2 do
    begin
    aux:=P[i+j];
    P[i+j]:=P[n-j+1];
    P[n-j+1]:=aux;
    end; { for }
 Indicator:=true;
1:end; { GenerarePermutari }
begin
 assign(f1, 'dezastru.in');
 assign(f2, 'dezastru.out');
 reset(f1);
 read(f1,n,k);
 for i:=1 to n do read(f1,x[i]);
 close(f1);
 Indicator:=false;
 repeat
 GenerarePermutari(Indicator);
 aux:=1;
 if Indicator then
 for i:=1 to k do aux*=x[P[i]];
 writeln;
 rasp+=aux/6;
 until not Indicator;
 rewrite(f2);
 append(f2);
 write(f2,rasp:1:6);
 close(f2);
end.