Cod sursa(job #601125)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 4 iulie 2011 23:39:40
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.55 kb
Program fractii_2;
 var a:array [1..500000,1..2] of longint;
  i,j,n,s,k:longint;
  fi,fo:text;
 function cmmdc(x,y:longint):boolean;
 var i,j:longint;
 begin
 cmmdc:=true;
  if x>=y then if x mod y=0 then cmmdc:=false
            else
               for i:=2 to y div 2 do
                if (y mod i=0) and (x mod i=0) then begin
                                                    cmmdc:=false;
                                                    break;
                                                    end
               else if i=y div 2 then
                                   cmmdc:=true;
  if y>x then if y mod x=0 then cmmdc:=false
           else
             for i:=2 to x div 2 do
                if (y mod i=0) and (x mod i=0) then begin
                                                    cmmdc:=false;
                                                    break;
                                                    end
               else if i=x div 2 then
                                   cmmdc:=true;
   end;
begin
 assign(fi,'fractii.in');
  reset(fi);
   read(fi,n);
 assign(fo,'fractii.out');
  rewrite(fo);
  k:=1;
 for i:=1 to (n div 2+n mod 2) do
  for j:=1 to 2 do begin
   a[i,j]:=k;
   if k>n then a[i,j]:=0;
   inc(k);
   end;
 for i:=2 to (n div 2+n mod 2) do
  for j:=1 to n div 2 do
   if cmmdc(a[i,1],a[j,2]) then s:=s+2;
 for i:=2 to (n div 2+n mod 2)-1 do
  for j:=i+1 to (n div 2+n mod 2) do
   if cmmdc(a[j,1],a[i,1]) then s:=s+2;
  s:=s+(n div 2+n mod 2)*2+(n div 2)*2;
 write(fo,s-1);
 close(fo);
end.