Cod sursa(job #524185)

Utilizator gicu_01porcescu gicu gicu_01 Data 20 ianuarie 2011 16:35:32
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.82 kb
var b:array[1..1000000]of boolean;
    n,s:longint; f:text;
procedure ciur;
var i,j:longint;
begin
 for i:=1 to n do b[i]:=true;
 b[1]:=false;
 for i:=1 to n do
  if b[i] then
   begin
    j:=i*2;
    while j<=n do
     begin
      b[j]:=false;
      j:=j+i;
     end;
   end;
end;

function linie(k,p:integer):longint;
var i,l:longint;
begin
 l:=0;
 for i:=k to n do
  if i mod p=0 then inc(l);
 linie:=l
end;

procedure mat;
var i,j,k,p:longint;
begin
 for i:=2 to n do
  begin
   p:=0;
   for j:=2 to i do
    if (b[j])and(i mod j=0) then
     begin
      k:=linie(i,j)-1;
      s:=s-2*k;
     end;
  end;
end;


begin
 assign(f,'fractii.in');
 reset(f);
 readln(f,n);
 close(f);
 s:=n*n-n+1;
 ciur;
 mat;
 assign(f,'fractii.out');
 rewrite(f);
 writeln(f,s);
 close(f);
end.