Cod sursa(job #251716)

Utilizator FllorynMitu Florin Danut Flloryn Data 3 februarie 2009 10:28:40
Problema Frac Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.71 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.