Cod sursa(job #150639)

Utilizator ZillaMathe Bogdan Zilla Data 7 martie 2008 10:23:10
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.03 kb
program fractii;

var a,b,s,s1,a1,b1:longint;
    ciur:array[1..1000001]of 0..1;
 n:longint;

f,g:text;


function cmmdc(a1,b1:longint):longint;

var r:longint;

begin

repeat

r:=a1 mod b1;

   a1:=b1;

  b1:=r;

 until r=0;

 cmmdc:=a1;

end;


begin
     assign(f,'fractii.in');
     assign(g,'fractii.out');
     reset(f);
     rewrite(g);
     read(f,n);
     for a:=1 to n do
       ciur[a]:=1;
     for a:=2 to n div 2 do
       if ciur[a]=1 then
          for b:=2 to n div a do
             ciur[a*b]:=0;
     s:=n*n-(n-1);

     s1:=0;
     for a:=4 to n do
     begin
          for b:=2 to a-1 do
          begin
               a1:=a;
               b1:=b;
               if (a1 mod 2=0) and (b1 mod 2=0) then s1:=s1+2
               else
                   if (ciur[a1]=1) and (ciur[b1]=1) then s1:=s1
                   else
                       if (cmmdc(a1,b1)<>1) then s1:=s1+2;
          end;
     end;
     s:=s-s1;
     write(g,s);
     close(f);
     close(g);
end.