Cod sursa(job #168992)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 31 martie 2008 22:34:06
Problema Dezastru Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.92 kb
program dezastru;
var A : array [1..25] of real;
    B : array [1..25] of shortint;
    n,m,i : shortint;
    nr : longint;
    S : real;
    f,g : text;
procedure wri(p:shortint);
var i : shortint;
    r : real;
begin
nr := nr+1;
r := 1;
for i := 1 to p do
r := r*A[B[i]];
S := S+r;
end;


function valid(p:shortint):boolean;
var ok : boolean;
    i : shortint;
begin
ok := true;
for i := 1 to p-1 do
if B[i]=B[p] then begin
                  ok := false;
                  break;
                  end;
valid := ok;
end;


procedure back(p:integer);
var pval : shortint;
begin
for pval := 1 to n do begin
B[p] := pval;
if valid(p) then if p=m then wri(p)
            else back(p+1);
end;
end;

begin
assign(f,'dezastru.in');
reset(f);
assign(g,'dezastru.out');
rewrite(g);
readln(f,n,m);
for i := 1 to n do
read(f,A[i]);

nr := 0;
back(1);

write(g,S/6:1:6);
close(f);
close(g);
end.