Cod sursa(job #168809)

Utilizator black_pussaasd sada black_puss Data 31 martie 2008 19:50:41
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.68 kb
program fractii;
var f,g:text;
    n,i,j,a,b,r,nr:longint;
    v:array[1..10000]of longint;
begin
  assign(f,'fractii.in');
  reset(f);
  readln(f,n);
  close(f);
  nr:=0;
  for i:=2 to n do
   if v[i]=0 then
    begin
     j:=i;
     if ((j+j)<=n) then
      begin
       j:=j+i;
       repeat
        v[j]:=1;
        j:=j+i;
       until j>=n;
      end;
    end;

  nr:=(2*n)-1;
  for i:=2 to n do
   for j:=2 to n do
    if i<>j then
     if (v[i]=0) and (v[j]=0) then
      inc(nr) else
      if ((v[i]=0) or (v[j]=0)) and ((i mod j<>0) and (j mod i<>0)) then
       inc(nr);
  assign(g,'fractii.out');
  rewrite(g);
  write(g,nr);
  close(g);
end.