Cod sursa(job #238355)

Utilizator MihaiBunBunget Mihai MihaiBun Data 1 ianuarie 2009 22:48:50
Problema Frac Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.94 kb
program frac;
var f:text;
    d,m,n,p,i,n1,r,s,j:int64;
    fp:array[1..10000] of int64;
    a:array[1..1000000] of 0..1;
begin
  assign(f,'frac.in');
  reset(f);
  readln(f,n,p);
  close(f);
  assign(f,'frac.out');
  rewrite(f);
  d:=2;
  m:=0;
  n1:=n;
  while (n<>1) and (d*d<n) do
     begin
       if n mod d=0 then begin
                            m:=m+1;
                            fp[m]:=d;
                            while n mod d=0 do n:=n div d;
                         end;

       d:=d+1;
     end;
  if n<>1 then begin
                m:=m+1;
                fp[m]:=n
               end;
  prod:=n1;
  for i:=1 to m do
     prod:=(prod div fp[i])*(fp[i]-1);

  for i:=1 to m do
  begin
     j:=0;
     repeat
       j:=j+fp[i];
       a[j]:=1;
     until j>((p div prod)+1)*n1;
  end;
  i:=0;
  s:=0;
  repeat
    i:=i+1;
    if a[i]=0 then s:=s+1;
  until s=p;
  write(f,i);
  close(f)
  end.