Nombre Password [ Regístrate ]

Fracciones ordenadas (OIE 2 - 1998) - Código en Pascal
{$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.


© (2001-2008) ALGORITMIA.NET - Política de privacidad