Cod sursa(job #575444)

Utilizator tibi9876Marin Tiberiu tibi9876 Data 8 aprilie 2011 12:30:47
Problema Frac Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.86 kb
var a:array[1..10000] of longint;
    s,t,pr,nr,n,k,p,i,j:longint;
    ok:boolean;
begin
assign(input,'frac.in');reset(input);
assign(output,'frac.out');rewrite(output);
readln(n,p);
nr:=0;k:=2;
while (n>1) and (k<=trunc(sqrt(n))) do
begin
if n mod k=0 then
begin
inc(nr);
a[nr]:=k;
while n mod k=0 do n:=n div k;
end;
inc(k);
end;
if n>1 then
begin
inc(nr);
a[nr]:=n;
end;
n:=nr;t:=0;pr:=1;
for i:=1 to n do
pr:=pr*a[i];
for i:=1 to (1 shl n)-1 do
begin
nr:=0;k:=1;
for j:=0 to n-1 do
if (1 shl j) and i>0 then
begin
k:=k*a[j+1];
inc(nr);
end;
if odd(nr) then t:=t+pr div k else t:=t-pr div k;
end;
t:=pr-t;
s:=p div t*pr;
p:=p mod t;
if p>0 then
for i:=1 to pr do
begin
inc(s);
ok:=true;
for j:=1 to n do
if i mod a[j]=0 then
begin
ok:=false;
break;
end;
if ok then dec(p);
if p=0 then break;
end;
write(s);
end.