Cod sursa(job #27136)

Utilizator CezarMocanCezar Mocan CezarMocan Data 6 martie 2007 09:45:49
Problema Zero 2 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.73 kb
const inf=10000000000000000;
var n,b,i,j,contor:longint;
    nr,min,t,ant,aux,s,sm,k,pu:int64;
    f,p,zero:array[0..5000]of longint;
    v:array[1..5000]of int64;

procedure descomp(n:longint);
var d,i:longint;
begin
if n mod 2=0 then
        begin
        inc(f[0]);
        f[1]:=2;
        while n mod 2=0 do
                begin
                inc(p[1]);
                n:=n div 2;
                end;
        end;
d:=3;
while (n>1) do
        begin
        while (n mod d<>0)and(d*d<=n) do
                inc(d,2);
        if d*d>n then
                begin
                inc(f[0]);
                f[f[0]]:=n;
                p[f[0]]:=1;
                exit;
                end;
        inc(f[0]);
        f[f[0]]:=d;
        while n mod d=0 do
                begin
                inc(p[f[0]]);
                n:=n div d;
                end;
        end;
end;

begin
assign(input,'zero2.in');reset(input);
assign(output,'zero2.out');rewrite(output);
for contor:=1 to 10 do
        begin
        readln(n,b);
        descomp(b);
        for i:=1 to f[0] do
                begin
                pu:=f[i];
                sm:=pu;
                while sm<=n do
                        begin
                        k:=n div sm-1;
                        s:=s+k*(k+1) div 2*sm+(k+1)*(N-(k+1)*sm+1);
                        sm:=sm*pu;
                        end;
                v[i]:=s div p[i];
                sm:=0;
                s:=0;
                end;
        min:=inf;
        for i:=1 to f[0] do
                if v[i]<min then
                        min:=v[i];
        writeln(min);
        f:=zero;
        p:=zero;
        end;
close(input);close(output);
end.