{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
{Programed By FR, 2/04/2006}
type
fracc = record {estructura de una fraccion }
divisor,dividendo : byte;
end;
list = array [1..8000] of fracc;
var
n,dividendo,divisor : byte;
c,i : integer;
A : list;{para guardar las fracciones}
procedure ReadData;
var fe : text;
begin {FRAC.OUT}
assign(fe,'FRAC.DAT');reset(fe);
read(fe,n);
close(fe);{cierra el fichero}
end;
function mcd(r,a : byte) : byte; {usa el algoritmo de Euclides}
begin
if r = 0 then mcd:=a
else
mcd:=mcd(a mod r,r); {parte recursiva del algoritmo}
end;
procedure Solucion;
begin
c:=0; {contador de fracciones}
for dividendo:=1 to n-1 do
for divisor:=dividendo+1 to n do {estos dos ciclos son para tomar todas las posibilidades}
if mcd(divisor,dividendo) = 1 then begin {fraccion irreducible}
inc(c);
A[c].dividendo:=dividendo; {guarda la fraccion encontrada}
A[c].divisor:=divisor;
end;
end;
procedure QSort(var a : list ; Lo,Hi: integer);
var
i,j : integer;
x : real;
yf : fracc;
procedure sort(l,r:integer);
begin
i:=l; j:=r; x:=a[(l+r) DIV 2].dividendo/a[(l+r) DIV 2].divisor;
repeat
while a[i].dividendo/a[i].divisor<x do i:=i+1;
while x<a[j].dividendo/a[j].divisor do j:=j-1;
if i<=j then
begin
yf:=a[i]; a[i]:=a[j]; a[j]:=yf;
i:=i+1; j:=j-1;
end;
until i>j;
if l<j then Sort(l,j);
if i<r then Sort(i,r);
end;
begin{QSort}
Sort(lo,hi)
end;
procedure print;
var fs : text; {fichero de salida}
begin {FRAC.DAT}
assign(fs,'FRAC.OUT');rewrite(fs);
for i:=1 to c do
writeln(fs,A[i].dividendo,' ',A[i].divisor);{las escribe en el formato}
{pedido}
close(fs);
end;
begin
ReadData;{lee los datos del fichero de entrada}
Solucion;{busca todas las fracciones con la propiedad descrita}
QSort(a,1,c);{ordena las fraccines encontradas}
print;{escribe las fracciones en el fichero de salida}
end.
|