Cod sursa(job #38364)

Utilizator fogabFodor Gabor fogab Data 25 martie 2007 18:26:48
Problema Frac Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.38 kb
var f:text;
    n,p,r,max,szor,i2,i3,nr,nr2,n2:int64;
    var a:array[1..15] of int64;
    b1,b2:array[1..8000] of int64;
    k,k2,k3,i:integer;

procedure build(l,l2,l3:integer;s:int64);
var i:integer;
begin
if l=l2 then begin
             if l2 mod 2=0 then
               begin
               inc(k2);
               b1[k2]:=s;
               end else
               begin
               inc(k3);
               b2[k3]:=s;
               end;
             end
else
for i:=l3+1 to k do
  build(l+1,l2,i,s*a[i]);
end;

begin
assign(f,'frac.in');
reset(f);
read(f,n,p);
close(f);
n2:=n;
r:=2;
max:=n;
while n<>1 do
  begin
    if n mod r=0 then
      begin
        inc(k);
        a[k]:=r;
        max:=max-max div r;
      end;
    while (n mod r)=0 do
           n:=n div r;
    inc(r);
    if r>sqrt(n) then
      begin
      inc(k);
      a[k]:=n;
      max:=max-max div n;
      break;
      end;
  end;
{2^k -1}
for i:=2 to k+1 do
  build(1,i,0,1);
szor:=p div max;
p:=p mod max;
if p=0 then
  begin
  dec(szor);
  p:=max;
  end;
n:=n2;
i2:=0;
i3:=n+1;
{N*logN}
while i3-i2>1 do begin
  nr:=0;
  nr2:=(i3+i2) div 2;
  for i:=1 to k2 do nr:=nr+(nr2 div b1[i]);
  for i:=1 to k3 do nr:=nr-(nr2 div b2[i]);
  if (nr2-nr)<p then i2:=nr2
     else i3:=nr2;
  end;
assign(f,'frac.out');
rewrite(f);
writeln(f,szor*n+i3);
close(f);
end.