Cod sursa(job #227464)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 4 decembrie 2008 18:41:07
Problema Zero 2 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.28 kb
var p:array[0..10000] of int64;
    e:array[0..10000] of int64;
    f,g:text;
    t,i,n,b:longint;
    x,min:int64;
function s(n,p:longint):int64;
 var k:longint;
     suma,mo:int64;
 begin
  k:=n div p-1;
  mo:=n - (k+1)*p +1;
  suma:=k;
  suma:=(suma*(suma+1)) shr 1;
  suma:=suma*p;
  mo:=mo*(k+1);
  s:=suma+mo;
 end;

function nr(n,p:int64):int64;
 var suma,aux:int64;
 begin
  aux:=p;
  suma:=0;
  while p<=n do begin
   suma:=suma+s(n,p);
   p:=p*aux;
  end;
  nr:=suma;
 end;

procedure solve;
 begin
  read(f,n,b);
  p[0]:=0;
  if b and 1=0 then begin
   p[0]:=1;
   p[1]:=2;
   e[p[0]]:=0;
   while b and 1=0 do begin
    e[1]:=e[1]+1;
    b:=b shr 1;
   end;
  end;
  x:=3;
  while x<=trunc(sqrt(b)) do begin
   if b mod x=0 then begin
    inc(p[0]);
    p[p[0]]:=x;
    e[p[0]]:=0;
    while b mod x=0 do begin
     inc(e[p[0]]);
     b:=b div x;
    end;
   end;
   x:=x+2;
  end;
  if b<>1 then begin
   inc(p[0]);
   p[p[0]]:=b;
   e[p[0]]:=1;
  end;
  min:=nr(n,p[1]) div e[1];
  for i:=2 to p[0] do begin
   x:=nr(n,p[i]) div e[i];
   if x<min then
    min:=x;
  end;
  writeln(g,min);
 end;
begin
 assign(f,'zero2.in'); reset(f);
 assign(g,'zero2.out'); rewrite(g);
 for t:=1 to 10 do
  solve;
 close(f); close(g);
end.