Cod sursa(job #101748)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 13 noiembrie 2007 20:11:39
Problema Grupuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.11 kb
var v,l:array[0..10000]of longint;
    m:array[0..10000,0..10000]of longint;
    i,j,d:longint;
    n,k,o,p,a,b,c:int64;
    f:text;
begin
   assign(f,'grupuri.in');
   reset(f);
   read(f,k,n);
   for i:=1 to n do
   begin
   read(f,v[i]);
   l[i]:=v[i];
   o:=o+v[i];
   end;
   a:=1;
   b:=o;
   while(b-a)>1do
   begin
   i:=0;
   j:=0;
   c:=(a+b)div 2+(a+b)mod 2;
   l:=v;
   p:=n;
   repeat
   i:=i+1;
   j:=0;
   repeat
   j:=j+1;
   m[i,j]:=p;
   l[p]:=l[p]-1;
   if l[p]=0 then p:=p-1;
   until j=c;
   if p=m[i,1] then p:=p-1;
   until p<=0;
   if(i>=k)and(m[c,k]>0)then a:=(a+b)div 2+(a+b)mod 2
                        else b:=(a+b)div 2+(a+b)mod 2;
   for d:=1 to i do
   for j:=1 to c do
   m[d,j]:=0;
   end;
   i:=0;
   j:=0;
   c:=b;
   l:=v;
   p:=n;
   repeat
   i:=i+1;
   j:=0;
   repeat
   j:=j+1;
   m[i,j]:=p;
   l[p]:=l[p]-1;
   if l[p]=0 then p:=p-1;
   until j=c;
   if p=m[i,1] then p:=p-1;
   until p<=0;
   close(f);
   assign(f,'grupuri.out');
   rewrite(f);
   if(m[c,k]>0)then writeln(f,b)
               else writeln(f,a);
   close(f);
end.