Cod sursa(job #133269)

Utilizator TudorutzuMusoiu Tudor Tudorutzu Data 8 februarie 2008 00:31:14
Problema Fractii Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.84 kb
var a,b:array[1..1000000] of boolean;
    f,g:text;
    i,n,k,x,nr,j:longint;
begin
     assign(f,'fractii.in'); reset(f);
     assign(g,'fractii.out'); rewrite(g);
     readln(f,n);
     nr:=0;
     for i:=2 to n do
     begin
          x:=i div 2+1;
          for j:=2 to x do
          begin
            if i mod j=0 then
            begin
               k:=0;
               while k<=n do
               begin
                    k:=k+j;
                    a[k]:=true;
               end;
            end;
          end;
          k:=0;
          while k<=n do
          begin
               k:=k+i;
               a[k]:=true;
          end;
          for j:=1 to n do
               if a[j]=false then inc(nr)
                             else a[j]:=false;
     end;
     nr:=nr+n;
     writeln(g,nr);
     close(g);
end.