Cod sursa(job #292281)

Utilizator katamashCatalin Tamas katamash Data 30 martie 2009 22:20:04
Problema Frac Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.22 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.