Cod sursa(job #365969)

Utilizator SpiderManSimoiu Robert SpiderMan Data 20 noiembrie 2009 16:40:20
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.92 kb
program eratostene;

 var a:array[1..1000000]of longint;
 ciur:array[1..1000000] of longint;
 b:array[1..1000000]of longint;
     n,i,j,s,c,m:longint;
     g:text;
 begin
  assign(g,'fractii.in');
  reset(g);
  readln(g,n);
  close(g);
  a[1]:=n;
  for i:=2 to n do
   a[i]:=n-1;
  for i:=2 to n div 2 do
    for j:=2 to n div i do
      ciur[i*j]:=0;
  for i:=1 to n do
     b[i]:=1;
  i:=2;
  while i<=n div 2 do
   begin
    if a[i]=n-1 then

    for j:=1 to n div i do
     begin
       for m:=2 to n div 2 do
       if ((i*j) mod m=0) and (ciur[m]=1) then
       begin
        b[i*j]:=b[i*j]*m;
        c:=c+1;
       end;
       if ((c=2) and (b[i*j]<>i)) or (c>2) then
       a[i*j]:=a[i*j]-n div i+2
       else
       a[i*j]:=a[i*j]-n div i+1;
     end;

    inc(i);
   end;
  for i:=1 to n do
   s:=s+a[i];
  assign(g,'fractii.out');
  rewrite(g);
  writeln(g,s);
  close(g);
 end.