Cod sursa(job #31796)

Utilizator andrei_infoMirestean Andrei andrei_info Data 16 martie 2007 16:03:30
Problema Zero 2 Scor 63
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.81 kb
//zero 2 infoarena preoni 2007runda3

var p,putere :array[1..20] of longint;
    nrfact,n,b:longint;

procedure factprimi;
var i,j,max:longint;
begin
if b mod 2 = 0 then
        begin
        p[1]:=2;
        nrfact:=1;
        while b mod 2 = 0 do
                begin
                b:=b div 2;
                inc(putere[1]);
                end;

        end;
i:=3;
while i <= trunc(sqrt(b)) do
        begin
        if (b mod i = 0) then
                begin
                inc(nrfact);
                p[nrfact]:=i;
                while b mod i = 0 do
                        begin
                        b:=b div i;
                        inc(putere[nrfact]);
                        end;

                end;
        i:=i+2;
        end;
if b > 1 then
        begin
        nrfact:=nrfact+1;
        p[nrfact]:=b;
        putere[nrfact]:=1;
        end;
end;

function s(n,p:longint):int64;
var k: longint;
begin
k:=(n div p)-1;
s:=(k*(k+1) div 2)*p + (k+1) * ( n-(k+1)*p+1);
end;

function nr(n,p:longint):int64;
var i:longint;
   pp,rez:int64;
begin
pp:=p;
rez:=0;
while pp <= n do
        begin
        rez:=rez+s(n,pp);
        pp:=pp*p;
        end;
nr:=rez;
end;

procedure calc;
var min,rez:int64;
     i:longint;
begin
min:=1 shl 62;
for i:=1 to nrfact do
        begin
        rez:=nr(n,p[i]);
        if rez div putere[i] < min then
                min:=rez div putere[i];
        end;

writeln(min);
end;


begin
assign(input,'zero2.in'); reset(input);
assign(output,'zero2.out'); rewrite(output);
while not eof do
        begin
        readln(n,b);
        fillchar(putere,sizeof(putere),0);
        fillchar(p,sizeof(p),0);
        nrfacT:=0;
        factprimi;
        calc;

        end;
        close(input); closE(output);
end.