Cod sursa(job #42671)

Utilizator raduzerRadu Zernoveanu raduzer Data 29 martie 2007 13:43:37
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.95 kb
var a:array[1..1000000]of integer;
    b:array[1..80000]of longint;
    n,s,i,j,z:longint;
begin
     assign(input,'fractii.in');
     reset(input);
     assign(output,'fractii.out');
     rewrite(output);
     readln(n);
     for i:=2 to n do
     begin
          if a[i]=0 then
          begin
               z:=z+1;
               b[z]:=i;
          end;
          j:=i;
          while j<=n do
          begin
               j:=j+i;
               if j>n then break;
               a[j]:=1;
          end;
     end;
     s:=n*2-1;
     if n=2 then s:=2;
     for i:=1 to z do
     begin
          for j:=2 to n do
          begin
               if j mod b[i]>0 then
               begin
                    if a[j]=1 then
                    begin
                         s:=s+2;
                    end
                    else s:=s+1;
               end;
          end;
     end;
     writeln(s);
close(output);
end.