Cod sursa(job #123349)

Utilizator DonPushmeMilitaru Adrian DonPushme Data 15 ianuarie 2008 17:31:20
Problema Fractii Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.04 kb
type vec=array[1..10000] of byte;
var v:vec;
    i,j,n,nr1,nr:longint;

procedure euler(i:longint;var nr:longint);
var sus,jos:longint;
begin
sus:=i;
jos:=1;
if v[i]<>0 then
   begin
   for j:=2 to (i div 2) do
       if (v[j]=0) and (i mod j=0) then
                                begin
                                sus:=sus*(j-1);
                                jos:=jos*j;
                                end;
   nr:=(sus div jos);
   nr:=2*nr-1;
   end
          else
          nr:=2*(sus div jos)-3;
end;

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

read(n);

for i:=2 to 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;
    end;

nr1:=n;
for i:=2 to n do
    begin
    euler(i,nr);
    nr1:=nr1+nr;
    end;

write(nr1);

close(input);
close(output);

end.