Cod sursa(job #188903)

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