Cod sursa(job #63325)

Utilizator cezar305Mr. Noname cezar305 Data 27 mai 2007 20:55:45
Problema Dezastru Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.25 kb
var k,i,g,n:longint;
    f,ff:qword;
    r,x:double;
    a:array[1..100] of double;
    s:array[1..100] of longint;
    ok:boolean;
    f1,f2:text;

procedure back(k:longint);
begin
        if k=g+1 then
        begin
                x:=1;
                for i:=1 to g do x:=x*a[s[i]];
                x:=x*ff;
                r:=r+x;
        end
        else
        begin
                s[k]:=s[k-1];
                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;
        ff:=1;
        for i:=1 to n do
        begin
                read(f1,a[i]);
                f:=f*i;
        end;
        for i:=1 to g do
                ff:=ff*i;
        for i:=1 to (n-g) do
                ff:=ff*i;
        if k=n then ff:=f;
        back(1);
        r:=r/f;
        writeln(f2,r:0:6);
        close(f1);
        close(f2);
end.