Cod sursa(job #334720)

Utilizator ionutz32Ilie Ionut ionutz32 Data 27 iulie 2009 19:56:07
Problema Fractii Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.79 kb
var v:array[1..20] of longint;
n,i,sol,d,x,nr,j:longint;
f,g:text;
function calc(fact,poz:longint):longint;
         var a:longint;
         begin
         a:=poz div v[fact];
         if fact=1 then
            calc:=a
         else
             calc:=calc(fact-1,poz)+a-calc(fact-1,a);
         end;
begin
assign(f,'fractii.in');
assign(g,'fractii.out');
reset(f);rewrite(g);
readln(f,n);
sol:=n;
for i:=2 to n do
    begin
    x:=i;
    d:=1;
    nr:=0;
    while x>1 do
          begin
          d:=d+1;
          if x mod d=0 then
             begin
             nr:=nr+1;
             v[nr]:=d;
             while x mod d=0 do
                   x:=x div d;
             end;
          end;
    sol:=sol+n-calc(nr,n);
    end;
write(g,sol);
close(f);close(g);
end.