Cod sursa(job #39778)

Utilizator adrianraduleaRadulea Adrian adrianradulea Data 26 martie 2007 22:46:15
Problema Dezastru Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.09 kb
var a:array[1..25] of real;
    st:array[0..25] of byte;
    n,i,j,k,m:byte;
    x:integer;
    p:real;
    sp:real;
    as,ev:boolean;
    f,g:text;
procedure init;
begin
st[k]:=0;
end;
procedure succesor;
begin
if st[k]<m then begin
  as:=true;
  st[k]:=st[k]+1;
end
           else as:=false;
end;
procedure valid;
begin
ev:=true;
for i:=1 to k-1 do
  if (st[i]=0) or (st[i]=st[i+1])then ev:=false;
end;
function solutie(k:byte):boolean;
begin
solutie:=k=n;
end;
procedure tipar;
begin
p:=1;
for i:=1 to n do p:=p*a[st[i]];
sp:=sp+p;
x:=x+1;
end;
begin
assign(f,'dezastru.in'); reset(f);
assign(g,'dezastru.out'); rewrite(g);
read(f,m,n);
sp:=0;
x:=0;
for i:=1 to m do read(f,a[i]);
st[0]:=0;
sp:=0;
k:=1;
init;
while k>0 do begin
  repeat
    succesor;
    if as then valid;
  until (not as) or (as and ev);
  if as then if solutie(k) then tipar
                           else begin
                             k:=k+1;
                             init;
                           end
        else k:=k-1;
end;
write(g,(sp/x):0:6);
close(g);
end.