Cod sursa(job #313347)

Utilizator marta_diannaFII Filimon Marta Diana marta_dianna Data 8 mai 2009 20:55:58
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.2 kb
program p1;
var i,n,x,d,y,l,j,nr:longint;
    a:array[1..1000000] of longint;
    b:array[0..10000] of longint;
    f,g:text;

function prim(x:longint):boolean;
var d,z:longint;
begin
     d:=1;
     prim:=true;
     z:=trunc(sqrt(x));
     while b[d]<=z do
           if x mod a[d]=0 then begin prim:=false;exit;end
                           else d:=d+1;
end;
begin
     assign(f,'fractii.in');reset(f);
     assign(g,'fractii.out');rewrite(g);
     read(f,n);
     b[0]:=2;
     b[1]:=2;
     b[2]:=3;
     x:=5;
     while x<=100000 do
           begin
                if prim(x) then begin b[0]:=b[0]+1; b[b[0]]:=x; end;
                x:=x+2;
           end;
     a[1]:=1;
     nr:=1;
     for i:=2 to n do
         begin
              d:=1;
              x:=i;
              y:=x;
              while x mod b[d]>0 do d:=d+1;
              l:=1;
              while y mod b[d]=0 do
                    begin
                         y:=y div b[d];
                         l:=l*b[d];
                    end;
              l:=l div b[d];
              a[i]:=a[y]* (b[d]-1)*l;
              nr:=nr+2*a[i];
          end;
     writeln(g,nr);
     close(f);
     close(g);
end.