Cod sursa(job #5087)

Utilizator CoolYceStanciucuCatalin CoolYce Data 10 ianuarie 2007 00:53:56
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.97 kb
var n,m,a,b,c,d,i,j,k,x:longint;
    v:array[1..100]of longint;

procedure citire;
begin
assign(input,'fractii.in');
reset(input);
readln(n);
close(input);
end;

procedure rezolvare;
begin
m:=n;
for i:=2 to n do begin
    x:=0;   j:=2;
    a:=i;
    while a<>1 do begin
       if a mod j=0 then begin
         while a mod j=0 do a:=a div j;
         inc(x);
         v[x]:=j;
         end;
       inc(j);
       end;
    if x>1 then begin
      b:=n;
      for j:=1 to x-1 do begin
        d:=n div v[j];
        b:=b-d;
        for k:=j+1 to x do begin
          c:=v[j]*v[k];
          c:=n div c;
          b:=b+c;
          end;
        end;
      d:=n div v[x];
      b:=b-d;
      end
           else begin
      c:=n div v[x];
      b:=n-c;
      end;
    inc(m,b);
    end;
end;

procedure afisare;
begin
assign(output,'fractii.out');
rewrite(output);
writeln(m);
close(output);
end;

begin
citire;
rezolvare;
afisare;
end.