Cod sursa(job #289766)

Utilizator b_ady20Branescu Adrian b_ady20 Data 26 martie 2009 23:06:29
Problema Frac Scor 100
Compilator fpc Status done
Runda aa Marime 1.04 kb
var p:array[0..10] of longint;
 n,x,m,rez,s,d,mijl,q:int64;
 i:longint;
function ver(x:int64):int64;
var i,j:longint;  pq:int64;   suma:int64;
begin
suma:=0;
for i:=1 to 1 shl p[0]-1 do
begin
pq:=-1;
for j:=0 to p[0]-1 do
if (i shr j) and 1=1 then
pq:=pq*(-p[j+1]);
suma:=suma+x div pq;
end;
ver:=suma;
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(input,'frac.in');
reset(input);
assign(output,'frac.out');
rewrite(output);
read (input,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;
s:=1; d:=1 shl 61;
while s<=d do
begin
mijl:=(s+d) shr 1;
q:=mijl-ver(mijl);
if q=m then
begin
if ok(mijl) then
begin
rez:=mijl;
break;
end
else
d:=mijl-1;
end
else
if q<m then
s:=mijl+1
else
d:=mijl-1;
end;
writeln(output,rez);
close(input);
close(output);
end.