Cod sursa(job #123355)

Utilizator DonPushmeMilitaru Adrian DonPushme Data 15 ianuarie 2008 17:41:47
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.12 kb
type vec=array[1..1000000] of byte;
var v:vec;
    i,j,n,nr1,nr:int64;

procedure euler(i:int64;var nr:int64);

var sus,jos:int64;

begin
sus:=i;
jos:=1;
if v[i]<>0 then
   begin
   j:=2;
   while j>= i div 2 do
       begin
       if (v[j]=0) and (i mod j=0) then
                                begin
                                sus:=sus*(j-1);
                                jos:=jos*j;
                                end;
       inc(j);
       end;
   nr:=(sus div jos);
   nr:=2*nr-1;
   end
          else
          nr:=2*(sus div jos)-3;
end;


begin {main}
assign(input, 'fractii.in');
assign(output,'fractii.out');
reset(input);
rewrite(output);

read(n);
i:=2;
while i<=n do
    begin
    if v[i]=0 then
              begin
              j:=i*2;
              while j<=n do
                    begin
                    v[j]:=1;
                    j:=j+i;
                    end;
              end;
    i:=i+2;
    end;

nr1:=n;
i:=2;
while i<=n do
    begin
    euler(i,nr);
    nr1:=nr1+nr;
    inc(i);
    end;

write(nr1);

close(input);
close(output);

end.