Cod sursa(job #12560)

Utilizator floringh06Florin Ghesu floringh06 Data 4 februarie 2007 12:50:55
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.61 kb
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}

var fi,fo:text;
    a,b,n,i,j,ct:longint;

begin
assign(fi,'fractii.in'); reset(fi);
assign(fo,'fractii.out'); rewrite(fo);
readln(fi,n);
ct:=1;
for i:=1 to n do
 begin
  j:=1;
 while j<=i-1 do
  begin
    a:=i;
    b:=j;
    while a<>b do
      if a>b then a:=a-b
       else b:=b-a;
    if a=1 then inc(j)
      else if i mod 2=1 then
        begin
          inc(j,2);
          inc(ct,2);
        end
        else inc(j);

    if a=1 then inc(ct,2);
   end;
 end;
write(fo,ct);
close(fi);
close(fo);
end.