Cod sursa(job #525477)

Utilizator ion_calimanUAIC Ion Caliman ion_caliman Data 25 ianuarie 2011 10:47:14
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.29 kb
var v:array[1..1000000] of boolean;
    a:array[1..1000000] of longint;
    b:array[1..100] of integer;
    n:longint;
    nr:longint;

procedure prime;
var i,j,k:longint;
begin
  for i:=1 to n do
  v[i]:=true;
  for i:=2 to round(sqrt(n)) do
    if v[i] then
      begin
        k:=i;
          while k+i<=n do
          begin
            inc(k,i);
            v[k]:=false;
          end;
      end;
end;

procedure DivizoriPrimi(t:longint; var m:longint);
var i,j:longint;
begin
  m:=0;
  for i:=2 to (t div 2) do
    if (v[i] and (t mod i=0)) then
      begin
        inc(m);
        a[m]:=i;
      end;
end;

procedure numara;
var i,j,k,m,t:longint;
begin
  nr:=n*n;
  for i:=2 to n do
    begin
      if v[i] then nr:=nr-(n div i)
      else begin
        DivizoriPrimi(i,m);
        for j:=1 to m do
          nr:=nr-(n div a[j]);
        if m>1 then
        for j:=1 to m-1 do
        for k:=j+1 to m do
          nr:=nr+(n div (a[j]*a[k]));
      end;
    end;
end;

procedure citire;
var f:text;
begin
  assign(f,'fractii.in');
  reset(f);
  read(f,n);
  close(f);
end;

procedure afis;
var f:text;
begin
  assign(f,'fractii.out');
  rewrite(f);
  write(f,nr);
  close(f);
end;

begin
  citire;
  prime;
  numara;
  afis;
end.