Cod sursa(job #50178)

Utilizator andrei_infoMirestean Andrei andrei_info Data 6 aprilie 2007 22:25:54
Problema GFact Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.82 kb
//infoarena gfact
var nrprim,factput : array[1..50000] of longint;
    p,q,nrprime : longint;
    b:int64;

{procedure init;
var i,j:longint;
begin
i:=2;
while i <= max_prim do
        begin
        if not prim[i] then
                begin
                j:=i+i;
                while j <= max_prim do
                        begin
                        prim[j]:=true;
                        j:=j+i;
                        end;
                end;
        i:=i+1;
        end;

nrprime:=0;
i:=2;
while i <= max_prim do
        begin
        if not prim[i] then
                begin
                inc(nrprime);
                nrprim[nrprime] := i;
                end;
        inc(i);
        end;
end;}

procedure citire;
var i:longint;
begin
assign(input,'gfact.in'); reset(input);
readln(p,q);
close(input);

{for i:=1 to nrprime do
        begin
        if p mod nrprim[i] = 0 then
                begin
                while p mod nrprim[i] = 0 do
                        begin
                        inc(factput[i]);
                        p:=p div nrprim[i];
                        end;
                factput[i]:=factput[i] * q;
                end;
        if p  < 2 then break;
        end;}
if p mod 2 = 0 then
        begin
nrprim[1]:=2; nrprime:=1;
while p mod 2 = 0 do
        begin
        inc(factput[1]);
        p:=p div 2;
        end;
factput[1]:=factput[1]*q;
end;
i:=3;
while p > 1 do
        begin
        if p mod i = 0 then
                begin
                inc(nrprime);
                nrprim[nrprime]:=i;
                while p mod i = 0 do
                        begin
                        inc(factput[nrprime]);
                        p:=p div i;
                        end;
                factput[nrprime]:=factput[nrprime]*q;
                end;
        inc(i,2);
        end;
end;

function putere(c,fact:int64):longint;
var rez:longint;
    i:int64;
begin
i:=fact;
rez:=0;

while ( c div i ) > 0 do
        begin
        inc(rez,c div i);
        i:=i*fact;
        end;
putere:=rez;
end;

function bbmin(fact,put : longint):int64;
var a,b,c,pp:int64;
begin
a:=1;
b:=fact*put;
while a <= b do
        begin
        c:=(a+b) div 2;
        pp:=putere(c,fact);
        if pp >= put then
                begin
                bbmin:=c;
                b:=c-1;
                end
        else
                a:=c+1;
        end;
end;

procedure calc;
var i:integer;
    r:int64;
begin
b:=0;
for i:=1 to nrprime do
        if factput[i] > 0 then
                begin
                r:=bbmin(nrprim[i],factput[i]);
                if r >  b then b:=r;
                end;
assign(output,'gfact.out'); rewrite(output);
writeln(b);
close(output);
end;

begin
//init;
citire;
calc;
end.