Cod sursa(job #1975451)

Utilizator _Victor_Victor Ciobanu _Victor_ Data 30 aprilie 2017 23:18:42
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.02 kb
Program Fractii;
type tab = array[1..1000000] of boolean;
var s,i,j,n,d: longint;
A: tab;
g,f:text;
function Euclid(a,b:longint): longint;
var C:longint;
begin
 while b <> 0 do
  begin
   c:= b;
   b:= a mod b;
   a:= c;
  end;
euclid:= a;
end;
procedure ciur(var A:tab;N:longint); 
var i,j: longint;
begin 
 for i:=1 to N do
  A[i]:= true;
for i:=2 to N do
 if A[i] = true then begin
  j:=0;
  while sqr(i) + j*i <= N do begin
   A[sqr(i)+j*i] := false;
   j:= j + 1;
   end;
 end;
end;
begin
assign(f,'fractii.in');reset(f);
assign(g,'fractii.out');rewrite(g);
readln(f,n);
ciur(A,n);
for i:=1 to n do
 for j:= 1 to n do begin
   if (i = 1) or (j = 1) then
    s:= s + 1
   else if (A[i] = true) and (A[j] = true) and (i <> j) then
    s:= s + 1
   else if ((A[i] = false) and (A[j] = true) and (i mod j <> 0)) or ((A[j] = false) and (A[i] = true) and (j mod i <> 0)) then
    s:= s + 1
    else if (A[i] = false) and (A[j]=false) and (euclid(i,j) = 1) then
     s:= s + 1;
 end;
writeln(g,s);
end.