Cod sursa(job #216739)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 25 octombrie 2008 16:03:26
Problema Zero 2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.05 kb
var f,g:text;
    v,a:array[0..32000]of int64;
    n,b,i,j,y,cb,p:longint;
    c,min,k:int64;


procedure fact(n:longint);
var p,cn:longint;
    c:int64;
begin
  cn:=n;
  for p:=2 to n do
    begin
      c:=0;
      while (cn mod p=0)do
        begin
          inc(c);
          cn:=cn div p;
        end;
      inc(v[p],c);
    end;
end;



begin
assign(f,'zero2.in');
assign(g,'zero2.out');
reset(f);
rewrite(g);
for i:=1 to 10 do
  begin
    read(f,n,b);
    for j:=2 to n do
      begin
        fact(j);
        for y:=1 to n do
          inc(a[y],v[y]);
      end;
    cb:=b;
    min:=-(-1 shl 63+1);
    for p:=2 to b do
      begin
        c:=0;
        while (cb mod p=0)do
          begin
            inc(c);
            cb:=cb div p;
          end;
        if (c>0)then
          begin
            k:=a[p] div c;
            if (k<=min)then min:=k;
          end;
      end;
    writeln(g,min);
    for j:=1 to n do
      begin
        a[j]:=0;
        v[j]:=0;
      end;
  end;
close(f);
close(g);
end.