Cod sursa(job #164788)

Utilizator yo_s_cantaCanta Andrei yo_s_canta Data 24 martie 2008 20:25:04
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.65 kb
var n,i,j,p:longint;
		s:array[1..10000] of longint;
    f:text;
function gcd(a,b:longint):longint;
var g:longint;
begin
	while a > 0 do Begin
  	g := a;
    a := b Mod a;
    b := g;
  end;
  gcd := g;
end;
begin
	assign(f,'fractii.in');reset(f);
  read(f,n);
  assign(f,'fractii.out');rewrite(f);
  for i := 1 to n do
  	s[i] := n;
  for i := 1 to n div 2 do
    for j := 1 to n div 2 do
  	begin
    	p:=2;
      if gcd(i,j)=1 then
        while (i*p<=n) AND (j*p<=n) do
          begin
	          dec(s[i*p]);
            inc(p);
          end;
    end;
  j:=0;
  for i :=1 to n do
  	inc(j,s[i]);
  write(f,j);
  close(f);
end.