Cod sursa(job #1060917)

Utilizator tureanchristinetunich tureanchristine Data 18 decembrie 2013 21:35:15
Problema Dezastru Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.37 kb
program permutari;
var x:array[1..20] of integer;
n,k,nr,p,i:integer;
s:real;
v:array[1..20] of real;
f,g:text;

procedure init(k:integer);
          begin
          x[k]:=0;
          end;

function exista(k:integer):boolean;
begin
     exista:=(x[k]<n);
     end;
function cont(k:integer):boolean;
var i:integer;
begin
cont:=true;
if k>1 then for i:=1 to k-1 do if x[k]=x[i] then cont:=false;
end;

function sol(k:integer):boolean;
begin sol:=(n=k);
end;

procedure tipar(k:integer);
var i:integer;
s1:real;
begin
s1:=1;
for i:=1 to nr do s1:=s1*(v[x[i]]);
s:=s+(s1/p);
end;

procedure bkt;
begin
k:=1;
init(k);
while k>0 do if exista(k) then begin
                               x[k]:=x[k]+1;
                               if cont(k) then if sol(k) then tipar(k)
                                                         else begin
                                                                   k:=k+1;
                                                                   init(k);
                                                                   end
                              end
                           else k:=k-1;
end;

begin
assign(f,'dezastru.in');reset(f);
assign(g,'dezastru.out');rewrite(g);
readln(f,n,nr);
p:=1;
for i:=1 to n do begin read(f,v[i]);  p:=p*i; end;
s:=0;
bkt;
write(g,s:5:6);
close(f);
close(g);
end.