Cod sursa(job #235390)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 23 decembrie 2008 17:42:52
Problema Zero 2 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.26 kb
var f,g:text;
    a,b:array[0..20]of longint;
    n,bz,i,j,l:longint;
    k,kk,min,p:int64;


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*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;
  if (n>1)then
    begin
      inc(l);
      a[l]:=n;
      b[l]:=1;
    end;
end;


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