Cod sursa(job #29503)

Utilizator cooldaCulda Bogdan coolda Data 9 martie 2007 15:15:26
Problema Zero 2 Scor 61
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.11 kb
program zero2;

var test:integer;
    n, b, i, q:longint;
    rez, x:int64;

function calc(p:longint):int64;
var t:longint;
begin
    t := p;
    calc := 0;
    while n >= t do
    begin
        inc(calc, t*((n-1) div t)*((n-1) div t - 1) div 2 +
            (n mod t + 1)*(n div t));
        if n div t < p then break;
        t := t*p;
    end;
end;

begin
    assign(input, 'zero2.in'); reset(input);
    assign(output, 'zero2.out'); rewrite(output);
    for test := 1 to 10 do
    begin
        readln(n, b);
        rez := maxlongint;
        i := 2;
        while i*i <= b do
        begin
            if b mod i = 0 then
            begin
                q := 0;
                while b mod i = 0 do
                begin
                    b := b div i;
                    inc(q);
                end;
                x := calc(i) div q;
                if x < rez then rez := x;
            end;
            inc(i);
        end;
        if b > 1 then
        begin
            x := calc(b);
            if x < rez then rez := x;
        end;
        writeln(rez);
    end;
end.