Cod sursa(job #5006)

Utilizator ProtomanAndrei Purice Protoman Data 9 ianuarie 2007 14:06:40
Problema Divizori Primi Scor 5
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.83 kb
var f1,f2:text; n,k:array[1..1000] of longint; v:array[1..10000] of byte;
    i,j,max,x,t,a:longint;
begin
assign(f1,'divprim.in');
reset(f1);
assign(f2,'divprim.out');
rewrite(f2);
read(f1,t);
for i:=1 to t do begin
read(f1,n[i]);
read(f1,k[i]);
if n[i]>max then max:=n[i];
end;
v[1]:=1;
for i:=2 to trunc(sqrt(max)) do begin
if v[i]=0 then begin
j:=i;
while j<max do begin
j:=j+i;
v[j]:=1;
end;
end;
end;
for i:=1 to t do begin
x:=0; max:=0;
while (x<>k[i])and(n[i]>0) do begin
x:=0;
j:=2;
while j<=trunc(sqrt(n[i])) do begin
if n[i] mod j=0 then begin
if v[j]=0 then inc(x);
if (v[n[i] div j]=0)and(n[i] div j<>j) then inc(x);
end;
if j=2 then inc(j)
       else j:=j+2;
end;
if x=k[i] then begin max:=1; writeln(f2,n[i]); end;
dec(n[i]);
end;
if max=0 then writeln(f2,0);
end;
close(f1);
close(f2);
end.