Cod sursa(job #187086)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 30 aprilie 2008 14:05:10
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.75 kb
var f,g:text;
    v:array[0..1000010]of 0..1;
    i,p,c,l:longint;
    n,t,s:int64;
begin
assign(f,'fractii.in');
assign(g,'fractii.out');
reset(f);
rewrite(g);
read(f,n);
if (n=1)then write(g,1) else
begin
  t:=n*(n-1)+1;
  c:=0;
  for i:=2 to n div 2 do
    begin
      v[i*2]:=1;
      inc(c);
    end;
  s:=0;
  for l:=1 to c do inc(s,l);
  dec(t,2*s);
  p:=3;
  while (p<=n div 2) do
    begin
      if (v[p]=0)then
        begin
          c:=0;
          s:=0;
          for i:=2 to n div p do
            begin
              v[i*p]:=1;
              inc(c);
            end;
          for l:=1 to c do inc(s,l);
          dec(t,2*s);
        end;
      inc(p,2);
    end;
  write(g,t);
end;
close(f);
close(g);
end.