Cod sursa(job #238242)

Utilizator MihaiBunBunget Mihai MihaiBun Data 1 ianuarie 2009 12:49:27
Problema Frac Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.9 kb
program frac;
var f:text;
    d,m,n,p,i,n1,r,s,j:longint;
    fp:array[1..10000000] of longint;
    a:array[1..10000000] 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;
  for i:=1 to m do
  begin
     j:=0;
     repeat
       j:=j+fp[i];
       a[j]:=1;
     until j>n1;
  end;
  r:=p mod n1;
  d:=p div n1;
  i:=0;
  s:=0;
  repeat
    i:=i+1;
    if a[i]=0 then s:=s+1;
  until s=r;
  write(f,i+n1*d);
  close(f)
  end.