Cod sursa(job #283839)

Utilizator andreirulzzzUPB-Hulea-Ionescu-Roman andreirulzzz Data 20 martie 2009 01:20:31
Problema Dezastru Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.21 kb
program dezastru;
var i,j,k,n,nr,p:longint;
    aux:real;
    a:array[1..28] of real;
    s,paco:real;
begin
assign(input,'dezastru.in');
reset(input);
readln(input,n,k);
for i:=1 to n do read(input,a[i]);
close(input);
s:=0;
for i:=1 to n-1 do
    if a[i]>a[i+1] then begin
       j:=i;
       while a[i]>a[i+1] do begin
             aux:=a[i];
             a[i]:=a[i+1];
             a[i+1]:=aux;
             dec(j);
             end;
       end;
paco:=a[1];
for j:=2 to k do paco:=paco*a[j];
s:=s+paco;
nr:=1;
repeat
      i:=n-1;
      while (i>0)and(a[i]>a[i+1]) do dec(i);
      if i>0 then begin
         for j:=n downto i+1 do
             if a[j]>a[i] then break;
         aux:=a[i];
         a[i]:=a[j];
         a[j]:=aux;
         j:=i+1; p:=n;
         while j<p do begin
               aux:=a[p];
               a[p]:=a[j];
               a[j]:=aux;
               inc(j);dec(p);
               end;
         paco:=a[1];
         for j:=2 to k do
             paco:=paco*a[j];
         s:=s+paco;
         inc(nr);
         end;               
until i=0;              
s:=s/nr;
assign(output,'dezastru.out');
rewrite(output);
write(output,s:0:6);
close(output);
end.