Cod sursa(job #364905)

Utilizator basketbalistu92alexandru catalisan basketbalistu92 Data 17 noiembrie 2009 13:22:36
Problema Divizori Primi Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.41 kb
type vector=array[1..7] of longint;

function prim(a:integer):boolean;
var i:integer;
    ok:boolean;
begin
  i:=2;
  ok:=true;
  while (ok)and(i<=trunc(sqrt(a))) do begin
    if a mod i=0 then ok:=false
    else inc(i);
  end;
  prim:=ok;
end;

function zii(a,k:longint):integer;
var d,i:integer;
begin
  i:=0;
  if a mod 2=0 then inc(i);
  d:=3;
  while (d<=a div 2)and(i<=k) do
  begin
    if a mod d=0 then begin if prim(d) then begin inc(i); inc(d,2);
                                            end
                                            else inc(d,2);
                      end
    else inc(d,2);
  end;
  zii:=i
end;

var k,n,t:longint;
    i,j,l,m:longint;
    v:vector;
    okn,okl:boolean;
begin
v[1]:=1;v[2]:=6;v[3]:=30;v[4]:=210;v[5]:=2310;v[6]:=30030;v[7]:=510510;
assign(input,'f:\divprim.in');reset(input);
assign(output,'f:\divprim.out');rewrite(output);
readln(t);
j:=1;

 while j<=t do begin
   readln(n,k);
   okn:=false;okl:=false;
   l:=v[k]+1;
   if n>=v[k] then begin m:=(v[k]+n)div 2;
     while (not okn)and(n>m) do
       if (zii(n,k)=k) then begin okn:=true;break;end else dec(n);

     while (not okl)and(l<=m) do
       if zii(l,k)=k then begin okl:=true;break;end else inc(l);

     if okn then writeln(n)
       else if okl then writeln(l)
         else writeln(v[k]);
   end
   else writeln(0);
   inc(j);
 end;
close(input);close(output);
end.