Cod sursa(job #58233)

Utilizator cezar305Mr. Noname cezar305 Data 4 mai 2007 18:58:01
Problema GFact Scor 5
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.38 kb
type sir=array[1..1000000] of integer;

var f1,f2:text;
    a,b,s1,s2,p,s,r:longint;
    i,j,n,q,h:longint;
    m,max,nr1:qword;
    v:sir;
    x:array[1..1000000] of longint;

procedure putere(d,x:qword);
begin
        p:=1;
        s:=0;
        while p*d<=x do
        begin
                p:=p*d;
                s:=s+x div p;
        end;
end;

procedure search(li,ls:qword);
begin
        m:=(li+ls) div 2;
        putere(a,m*a);
        s1:=s;
        putere(a,(m-1)*a);
        s2:=s;
        if (s1>=b)and(s2<b) then nr1:=m*a
                else if li<ls then if s1>=b then search(li,m-1)
                        else search(m+1,ls);
end;

procedure ciur(b:longint);
var i,j:longint;
begin
        i:=1;
        while ((i*i) shl 1)+(i shl 1)<=b do
        begin
                if v[i shr 3] and (1 shl (i and 7))=0 then
                begin
                        j:=((i*i)shl 1)+(i shl 1);
                        while 2*j+1<=b do
                        begin
                                v[j shr 3]:=v[j shr 3]or(1 shl(j and 7));
                                j:=j+(i shl 1)+1;
                        end;
                end;
                inc(i);
        end;
        i:=0;
        x[1]:=2;
        x[0]:=1;
        while 2*i+1<=n do
        begin
                inc(i);
                if v[i shr 3] and (1 shl (i and 7))=0 then
                begin
                        inc(x[0]);
                        x[x[0]]:=2*i+1;
                end;
        end;
end;

begin
        assign(f1,'gfact.in');
        reset(f1);
        assign(f2,'gfact.out');
        rewrite(f2);
        read(f1,h,q);
        j:=0;
        r:=h;
        ciur(r);
        while h<>1 do
        begin
                inc(j);
                i:=x[j];
                if h mod i=0 then
                begin
                        b:=0;
                        a:=i;
                        while h mod i=0 do
                        begin
                                inc(b);
                                h:=h div i;
                        end;
                        b:=b*q;
                        n:=j;
                        nr1:=0;
                        search(1,b);
                        if nr1>max then max:=nr1;
                end;
        end;
        writeln(f2,max);
        close(f1);
        close(f2);
end.