Cod sursa(job #430114)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 30 martie 2010 19:17:17
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.96 kb
var divizori:array [1..10] of integer;
    produse:array[1..1000] of longint;
    aux, n, i, j, k, i2, j2, k2, i3, j3, k3, sum, sump:longint;
    f, g:text;

begin
assign (f, 'fractii.in'); reset (f);
assign (g, 'fractii.out'); rewrite (g);

read (f, n);
sum:=n;
for i := 1 to n do
  begin
  aux:= i;
  j:=0; k:=2; sump:=0;
  while aux <> 1 do
    begin
    if aux mod k = 0 then
      begin
      j:=j+1;
      divizori[j]:=k;
      sump:=sump+(n- n div k);
      end;
    while aux mod k = 0 do aux := aux div k;
    k:=k+1;
    end;
  j2:=0; k2:=0;{j2 - Pozitia inainte de adaugare. k2-pozitia pe care se adaoga}
  for i2 := 1 to j do
    begin
    k2:=k2+1;
    produse[k2]:=divizori[i2];
    for i3:= 1 to j2 do
      begin
      k2:=k2+1;
      produse[k2]:= produse[i3]*divizori[i2];
      sump:=sump-(n- n div produse[k2]);
      end;
    j2:=k2;
    end;
  sum:=sum+sump;
  end;

write (g, sum);

close (f); close (g);
end.