Cod sursa(job #235360)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 23 decembrie 2008 15:46:08
Problema Zero 2 Scor 42
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.22 kb
var f,g:text;
    a,b,c,d:array[0..30]of longint;
    y,i,j,n,bz,l,ci,k:longint;


procedure fact(n:longint);
var i,c,d:longint;
begin
  c:=0;
  while (n mod 2=0)do
    begin
      inc(c);
      n:=n div 2;
    end;
  l:=0;
  if (c>0)then
    begin
      l:=1;
      a[l]:=2;
      b[l]:=c;
    end;
  d:=3;
  while (d<=n)do
    begin
      c:=0;
      while (n mod d=0)do
        begin
          inc(c);
          n:=n div d;
        end;
      if (c>0)then
        begin
          inc(l);
          a[l]:=d;
          b[l]:=c;
        end;
      inc(d,2);
    end;
end;


begin
assign(f,'zero2.in');
assign(g,'zero2.out');
reset(f);
rewrite(g);
for y:=1 to 10 do
  begin
    read(f,n,bz);
    fact(bz);
    for i:=1 to l do
      begin
        c[i]:=0;
        d[i]:=0;
      end;
    for i:=2 to n do
      begin
        ci:=i;
        for j:=1 to l do
          while (ci mod a[j]=0)do
            begin
              inc(c[j]);
              ci:=ci div a[j];
            end;
        for j:=1 to l do inc(d[j],c[j]);
      end;
    k:=maxlongint;
    for j:=1 to l do
      if (d[j] div b[j]<k)then k:=d[j] div b[j];
    writeln(g,k);
  end;
close(f);
close(g);
end.