Cod sursa(job #186407)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 27 aprilie 2008 21:15:40
Problema Frac Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.16 kb
var p:array[0..10] of longint;
    f,g:text;
    i:longint;
    rez,st,dr,mij,q:int64;
    n,x,m:int64;
function ver(x:int64):int64;
 var i,j:longint;
     pr:int64;
     sum:int64;
 begin
  sum:=0;
  for i:=1 to 1 shl p[0]-1 do begin
   pr:=-1;
   for j:=0 to p[0]-1 do
    if (i shr j) and 1=1 then
     pr:=pr*(-p[j+1]);
   sum:=sum+x div pr;
  end;
  ver:=sum;
 end;

function ok(x:int64):boolean;
 var i:longint;
 begin
  ok:=true;
  for i:=1 to p[0] do
   if x mod p[i]=0 then begin
    ok:=false;
    exit;
   end;
 end;

begin
 assign(f,'frac.in'); reset(f);
 assign(g,'frac.out'); rewrite(g);
 read(f,n,m);
 x:=n;
 for i:=2 to trunc(sqrt(n)) do
  if x mod i=0 then begin
   inc(p[0]);
   p[p[0]]:=i;
   while x mod i=0 do
    x:=x div i;
  end;
 if x<>1 then begin
  inc(p[0]);
  p[p[0]]:=x;
 end;
 rez:=0;
 st:=1; dr:=1 shl 61;
 while st<=dr do begin
  mij:=(st+dr) shr 1;
  q:=mij-ver(mij);
  if q=m then begin
   if ok(mij) then begin
    rez:=mij;
    break;
   end
   else
    dr:=mij-1;
  end
  else
   if q<m then
    st:=mij+1
   else
    dr:=mij-1;
 end;
 writeln(g,rez);
 close(f); close(g);
end.