Cod sursa(job #25333)

Utilizator runnaway90Oprescu Radu Constantin runnaway90 Data 4 martie 2007 12:02:16
Problema Zero 2 Scor 7
Compilator fpc Status done
Runda preONI 2007, Runda 3, Clasa a 9-a si gimnaziu Marime 2.8 kb
var f,g:text;
        a:array[1..100000,1..4]of longint;
        ok:boolean;
        rts,b,n,j,c,i,nr,min,k,radu:longint;

begin
     assign(f,'zero2.in');
     assign(g,'zero2.out');
     rewrite(g);
     reseT(f);
        for rts:=1 to 10 do
        begin
                read(f,n,b);
                radu:=b;
                c:=0;j:=0;
                while b mod 2=0 do
                begin
                        c:=c+1;
                        b:=b div 2;
                end;
                if c<>0 then
                begin
                        inc(j);
                        a[j,1]:=2;
                        a[j,2]:=c;
                end;
                i:=3;
                while (i<=round(sqrt(radu)))and(b<>1) do
                begin
                        if b mod i=0 then
                        begin
                                inc(j);c:=0;
                                while b mod i=0 do
                                begin
                                        inc(c);
                                        b:=b div i;
                                end;
                                a[j,1]:=i;
                                a[j,2]:=c;
                        end;
                        i:=i+2;
                end;
                if b<>1 then
                begin
                        inc(j);
                        a[j,1]:=b;
                        a[j,2]:=1;
                end;
                for i:=1 to n do
                begin
                        for k:=1 to j do
                        begin
                                ok:=false;
                             if i mod a[k,1]=0 then
                             begin
                                c:=i;
                                nr:=0;
                                while c mod a[k,1]=0 do
                                begin
                                        nr:=nr+1;
                                        c:=c div a[k,1];
                                end;
                                a[k,3]:=nr+a[k,3];
                                ok:=true;
                                a[k,4]:=a[k,3];
                             end;
                             if ok=false then
                                a[k,3]:=a[k,3]+a[k,4];
                        end;
                end;
                min:=2000000000;
                for i:=1 to j do
                begin
                     a[i,3]:=a[i,3] div a[i,2];
                     if a[i,3]<min then
                        min:=a[i,3];
                     a[i,1]:=0;
                     a[i,2]:=0;
                     a[i,3]:=0;
                     a[i,4]:=0;
                end;
                writeln(g,min);
        end;
     close(f);
     close(g);
end.