Cod sursa(job #334808)

Utilizator ionutz32Ilie Ionut ionutz32 Data 28 iulie 2009 09:20:19
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.76 kb
var a:array[0..7,1..1000000] of longint;
v:array[1..20] of longint;
n,i,j,sol,p,q:longint;
f,g:text;
function calc(fact,poz:longint):longint;
         var c:longint;
         begin
         c:=poz div a[fact,i];
         if fact=1 then
            calc:=c
         else
             calc:=calc(fact-1,poz)+c-calc(fact-1,c);
         end;
begin
assign(f,'fractii.in');
assign(g,'fractii.out');
reset(f);rewrite(g);
readln(f,n);
for i:=2 to n do
    if a[0,i]=0 then
       begin
       a[0,i]:=1;
       a[1,i]:=i;
       for j:=2 to n div i do
           begin
           a[0,j*i]:=a[0,j*i]+1;
           a[a[0,j*i],j*i]:=i;
           end;
       end;
sol:=n;
for i:=2 to n do
    sol:=sol+n-calc(a[0,i],n);
write(g,sol);
close(f);close(g);
end.