Cod sursa(job #63174)

Utilizator cezar305Mr. Noname cezar305 Data 27 mai 2007 11:35:47
Problema Dezastru Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.07 kb
var k,i,g,n:longint;
    f:qword;
    r,x:extended;
    a:array[1..100] of extended;
    s:array[1..100] of longint;
    ok:boolean;
    f1,f2:text;

procedure back(k:longint);
begin
        if k=n+1 then
        begin
                x:=1;
                for i:=1 to g do x:=x*a[s[i]];
                r:=r+x;
        end
        else
        begin
                s[k]:=0;
                while s[k]<n do
                begin
                        s[k]:=s[k]+1;
                        ok:=true;
                        for i:=1 to k-1 do
                        if s[k]=s[i] then ok:=false;
                        if ok then back(k+1);
                end;
        end;
end;

begin
        assign(f1,'dezastru.in');
        reset(f1);
        assign(f2,'dezastru.out');
        rewrite(f2);
        read(f1,n,g);
        f:=1;
        for i:=1 to n do
        begin
                read(f1,a[i]);
                f:=f*i;
        end;
        back(1);
        r:=r/f;
        writeln(f2,r:0:6);
        close(f1);
        close(f2);
end.