Cod sursa(job #49397)

Utilizator fogabFodor Gabor fogab Data 5 aprilie 2007 19:03:47
Problema Lapte Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.01 kb
var f:text;
    a:array[0..100,0..100] of integer;
    la,lb:array[1..100] of byte;
    ba,bb:array[0..11000] of word;
    n,m,i,k1,k2,mij:byte;

function ok(t:byte):boolean;
var i,j,l,h,x,y:byte;
    k,k2:integer;
begin
k:=0;
k2:=0;
fillchar(a,sizeof(a),0);
for i:=1 to n do
  begin
  k:=k2;
  for j:=0 to (t div la[i]) do
    begin
    h:=(t-j*la[i]) div lb[i];
    for l:=0 to k do
      begin
      x:=ba[l]+j;
      y:=bb[l]+h;
      if (x>m) then x:=m;
      if (y>m) then y:=m;
      if a[x,y]=0 then
         begin
         a[x,y]:=1;
         inc(k2);
         ba[k2]:=x;
         bb[k2]:=y;
         end;
      end;
    end;

    end;
if a[m,m]=1 then ok:=true
   else ok:=false;
end;

begin
assign(f,'lapte.in');
reset(f);
read(f,n,m);
for i:=1 to n do read(f,la[i],lb[i]);
close(f);
k1:=1;
k2:=100;
while k2-k1>1 do
  begin
  mij:=(k2+k1) shr 1;
  if ok(mij) then k2:=mij
     else k1:=mij;
  end;
assign(f,'lapte.out');
rewrite(f);
writeln(f,k1+1);
close(f);
end.