unit unit_bo;
{Programador: Juan Eladio Sanchez Rosas - 20020519}
interface
  const
    max=100;
  type
    vector=array[1..max]of integer;
    registros=record
              num:integer;
              end;
    archReg=file of registros;

{Arreglos}
 {Auxiliares}
  procedure allena_aleatorio(var arreglo:vector; n:integer);
  procedure allena_ordenado(var arreglo:vector; n:integer);
  procedure muestra_vector(arreglo:vector; n:integer);
  procedure muestra_vector2(arreglo:vector; n:integer);
  procedure intercambia_a(var arreglo:vector; pos1,pos2:integer);
 {Busquedas}
  procedure ba_secuencial(arreglo:vector; n,elemento:integer);
  procedure ba_binaria(arreglo:vector; n,elemento:integer);
 {Ordenamientos}
  procedure oa_slinealsim(var arreglo:vector; n:integer);
  procedure oa_slinealint(var arreglo:vector; n:integer);
  procedure oa_burbuja(var arreglo:vector; n:integer);
  procedure oa_bubble(var arreglo:vector; n:integer);
  procedure oa_shaker(var arreglo:vector; n:integer);
  procedure oa_insertlin(var arreglo:vector; n:integer);
  procedure oa_insertbin(var arreglo:vector; n:integer);
  procedure oa_shell(var arreglo:vector; n:integer);
  procedure oa_quicksort(var arreglo:vector; n:integer);
  procedure oa_ordindices(var arreglo:vector; n:integer);
  procedure oa_scuadrat(var arreglo:vector; n:integer);

{Archivos Binarios}
 {Auxiliares}
  procedure bllena_aleatorio(var archBin:archReg; n:integer);
  procedure bllena_ordenado(var archBin:archReg; n:integer);
  procedure muestra_archivo(var archBin:archReg);
  procedure muestra_archivo2(var archBin:archReg);
  procedure intercambia_b(var archBin:archReg; pos1,pos2:integer);
 {Busquedas}
  procedure bb_secuencial(var archBin:archReg; n,elemento:integer);
  procedure bb_binaria(var archBin:archReg; n,elemento:integer);
 {Ordenamientos}
  procedure ob_slinealsim(var archBin:archReg; n:integer);
  procedure ob_slinealint(var archBin:archReg; n:integer);
  procedure ob_burbuja(var archBin:archReg; n:integer);
  procedure ob_bubble(var archBin:archReg; n:integer);
  procedure ob_shaker(var archBin:archReg; n:integer);
  procedure ob_insertlin(var archBin:archReg; n:integer);
  procedure ob_insertbin(var archBin:archReg; n:integer);
  procedure ob_shell(var archBin:archReg; n:integer);
  procedure ob_quicksort(var archBin:archReg; n:integer);
  procedure ob_ordindices(var archBin:archReg; n:integer);
  procedure ob_scuadrat(var archBin:archReg; n:integer);

implementation
uses crt;

{INICIO de llenado de arreglo}
procedure allena_aleatorio(var arreglo:vector; n:integer);
  var i:integer;
  begin
  randomize;
  for i:=1 to n do
    arreglo[i]:=trunc(random(10)*random(10));
  end;
procedure allena_ordenado(var arreglo:vector; n:integer);
  var cont,aux:integer;
  begin
  randomize;
  for cont:=1 to n do
    arreglo[cont]:=0;
  cont:=1;
  arreglo[cont]:=trunc(random(10)*random(10));
  while cont<n do
    begin
    inc(cont);
    repeat
      aux:=random(10);
      arreglo[cont]:=arreglo[cont]+trunc(aux);
    until arreglo[cont]>arreglo[cont-1];
    end;
  end;
{FIN de llenado de arreglo}

{INICIO de impresion de arreglos}
procedure muestra_vector(arreglo:vector; n:integer);
var i:integer;
begin
  writeln('  [Elementos del arreglo]'); write('   ');
  for i:=1 to n do
    write(arreglo[i],' ');
  writeln;
  writeln;
end;
procedure muestra_vector2(arreglo:vector; n:integer);
var i:integer;
begin
  write('   ');
  for i:=1 to n do
    write(arreglo[i],' ');
  writeln;
end;
{FIN de impresion de arreglos}

procedure intercambia_a(var arreglo:vector; pos1,pos2:integer);
var aux:integer;
begin
  aux:=arreglo[pos1];
  arreglo[pos1]:=arreglo[pos2];
  arreglo[pos2]:=aux;
end;

  {INICIO de procedimientos de busqueda en arreglos}
  procedure ba_secuencial(arreglo:vector; n,elemento:integer);
  var cont:integer; hallado:boolean;
  begin
    cont:=0;
    hallado:=false;
    while (cont<n) and not hallado do
      begin
      inc(cont);
      if arreglo[cont]=elemento then
        hallado:=true;
      end;
    if hallado then
      writeln('  Elemento ',elemento,' encontrado en la posicion ',cont)
    else
      writeln('  Elemento ',elemento,' no hallado');
  end;

  procedure ba_binaria(arreglo:vector; n,elemento:integer);
  var izq,der,cen:integer; salir:boolean;
  begin
    izq:=0;
    der:=n;
    salir:=false;
    while not salir do
      begin
      cen:=(izq+der) div 2;
      if (elemento=arreglo[cen]) or (izq>=der) then
        salir:=true
      else
        if elemento>arreglo[cen] then
          izq:=cen+1
        else
          der:=cen-1;
      end;
    if elemento=arreglo[cen] then
      writeln('  Elemento ',elemento,' encontrado en la posicion ',cen)
    else
      writeln('  Elemento ',elemento,' no hallado');
  end;
  {FIN de procedimientos de busqueda en arreglos}

  {INICIO de procedimientos de ordenacion para arreglos}
  procedure oa_slinealsim(var arreglo:vector; n:integer);
  var i_ord,i_max,i,j,neutro,menor:integer; aaux:vector;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_vector(arreglo,n);
    writeln('  [Procesamiento en arreglo auxiliar]');
    {Inicio del metodo}
    menor:=arreglo[1];
    for j:=2 to n do
      if arreglo[j]<menor then
        menor:=arreglo[j];
    neutro:=menor-1;
    i_ord:=n;
    for j:=n downto 1 do
      begin
      i_max:=1;
      for i:=1 to n do
        if (arreglo[i_max]<arreglo[i]) and (arreglo[i]<>neutro) then
          i_max:=i;
      aaux[i_ord]:=arreglo[i_max];
      arreglo[i_max]:=neutro;
      dec(i_ord);
      end;
    arreglo:=aaux;
    write(#10,#13,'  Secuencia Clasificada!');
    muestra_vector(arreglo,n);
    readkey;
  end;

  procedure oa_slinealint(var arreglo:vector; n:integer);
  var i,j,i_menor,e_menor:integer;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_vector(arreglo,n);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    for i:=1 to n-1 do
      begin
      i_menor:=i;
      e_menor:=arreglo[i];
      for j:=i+1 to n do
        if arreglo[j]<e_menor then
          begin
          e_menor:=arreglo[j];
          i_menor:=j;
          end;
      intercambia_a(arreglo,i,i_menor);
      {Muestra proceso}
      if i=n-1 then
        begin
        muestra_vector(arreglo,n);
        end
      else
        muestra_vector2(arreglo,n);
      readkey;
      end;
  end;

  procedure oa_burbuja(var arreglo:vector; n:integer);
  var i,j:integer;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_vector(arreglo,n);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    for i:=1 to n-1 do
      begin
      for j:=i+1 to n do
        if arreglo[j]<arreglo[i] then
          begin
          intercambia_a(arreglo,i,j);
          end;
      {Muestra proceso}
      if i=n-1 then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_vector(arreglo,n);
        end
      else
        muestra_vector2(arreglo,n);
      readkey;
      end;
  end;

  procedure oa_bubble(var arreglo:vector; n:integer);
  var i,j:integer;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_vector(arreglo,n);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    for i:=1 to n-1 do
      begin
      for j:=n downto i+1 do
        begin
        if arreglo[j]<arreglo[j-1] then
          intercambia_a(arreglo,j,j-1);
        end;
      {Muestra proceso}
      if i=n-1 then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_vector(arreglo,n);
        end
      else
        muestra_vector2(arreglo,n);
      readkey;
      end;
  end;

  procedure oa_shaker(var arreglo:vector; n:integer);
  var ultimo_inter,izquierda,derecha,i:integer;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_vector(arreglo,n);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    ultimo_inter:=n;
    izquierda:=2;
    derecha:=n;
    repeat
      for i:=derecha downto izquierda do
        if arreglo[i]<arreglo[i-1] then
          begin
          intercambia_a(arreglo,i,i-1);
          ultimo_inter:=i;
          end;
      izquierda:=ultimo_inter+1;
      for i:=izquierda to derecha do
        if arreglo[i] < arreglo[i-1] then
          begin
          intercambia_a(arreglo,i,i-1);
          ultimo_inter:=i;
          end;
      derecha:=ultimo_inter-1;
      {Muestra proceso}
      if derecha<izquierda then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_vector(arreglo,n);
        end
      else
        muestra_vector2(arreglo,n);
      readkey;
    until derecha<izquierda;
  end;

  procedure oa_insertlin(var arreglo:vector; n:integer);
  var i,elemento,j:integer;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_vector(arreglo,n);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    for i:=2 to n do
      begin
      elemento:=arreglo[i];
      j:=i;
      while (j>1) and (elemento<arreglo[j-1]) do
        begin
        arreglo[j]:=arreglo[j-1];
        dec(j);
        end;
      arreglo[j]:=elemento;
      {Muestra proceso}
      if i=n then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_vector(arreglo,n);
        end
      else
        muestra_vector2(arreglo,n);
      readkey;
      end;
  end;

  procedure oa_insertbin(var arreglo:vector; n:integer);
  var i,elemento,izquierda,derecha,medio,j:integer;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_vector(arreglo,n);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    for i:=2 to n do
      begin
      elemento:=arreglo[i];
      izquierda:=1;
      derecha:=i;
      while izquierda<derecha do
        begin
        medio:=(izquierda+derecha) div 2;
        if arreglo[medio]<=elemento then
          izquierda:=medio+1
        else
          derecha:=medio;
        end;
      for j:=i downto derecha do
        arreglo[j]:=arreglo[j-1];
      arreglo[derecha]:=elemento;
      {Muestra proceso}
      if i=n then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_vector(arreglo,n);
        end
      else
        muestra_vector2(arreglo,n);
      readkey;
      end;
  end;

  procedure oa_shell(var arreglo:vector; n:integer);
  var counters: array[1..3] of integer;
    s, i, j, d, k: integer;
    f: boolean;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_vector(arreglo,n);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    counters[1]:=5;
    counters[2]:=3;
    counters[3]:=1;
    for s:=1 to 3 do
    begin
      d:=counters[s];
      for j:=d+1 to n do
      begin
        f:=false;
        i:=j-d;
        k:=arreglo[j];
        while (i>0) and not f do
          if k>=arreglo[i] then
            f:=true
          else
          begin
            arreglo[i+d]:=arreglo[i];
            i:=i-d;
          end;
        arreglo[i+d]:=k;
      end;
      {Muestra proceso}
      if s=3 then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_vector(arreglo,n);
        end
      else
        muestra_vector2(arreglo,n);
      readkey;
    end;
  end;

  procedure oa_quicksort(var arreglo:vector; n:integer);
    procedure quick_sort(var arreglo: vector; lim_izq,lim_der: integer);
    var i,ultimo: integer;
    begin
      if lim_izq<lim_der then
      begin
        intercambia_a(arreglo,lim_izq,(lim_izq+lim_der) div 2);
        ultimo:=lim_izq;
        for i:=lim_izq+1 to lim_der do
          if arreglo[i]<arreglo[lim_izq] then
          begin
            inc(ultimo);
            intercambia_a(arreglo,ultimo,i);
          end;
        intercambia_a(arreglo,lim_izq,ultimo);
        quick_sort(arreglo,lim_izq,ultimo-1);
        quick_sort(arreglo,ultimo+1,lim_der);
      end;
    end;

  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_vector(arreglo,n);
    writeln('  Procesamiento recursivo');
    {Inicio del metodo}
    quick_sort(arreglo,1,n);
    write(#10,#13,'  Secuencia Clasificada!');
    muestra_vector(arreglo,n);
    readkey;
  end;

  procedure oa_ordindices(var arreglo:vector; n:integer);
  var indice:vector; i,j,aux:integer;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_vector(arreglo,n);
    writeln('  [Procesamiento en arreglo auxiliar]');
    {Inicio del metodo}
    for i:=1 to n do
      indice[i]:=i;
    for i:=1 to n-1 do
      for j:=i+1 to n do
        if arreglo[indice[i]]>arreglo[indice[j]] then
          begin
          aux:=indice[i];
          indice[i]:=indice[j];
          indice[j]:=aux;
          end;
    writeln(#10,#13,'  Secuencia Clasificada!  [Elementos del arreglo]');
    write('   ');
    for i:=1 to n do
      write(arreglo[indice[i]],' ');
    readkey;
  end;

  procedure oa_scuadrat(var arreglo:vector; n:integer);
  var
    i,j,k,h,menor,neutro,mayor_g,mayor_gs:integer;
    arreglo_final,grandes:vector;
    flag:boolean;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_vector(arreglo,n);
    writeln('  [Procesamiento en arreglo auxiliar]');
    {Inicio del metodo}
    menor:=arreglo[1];
    for j:=2 to n do
      if arreglo[j]<menor then
        menor:=arreglo[j];
    neutro:=menor-1;
    k:=trunc(sqrt(n));
    for i:=1 to n do
      begin
      j:=1;
      h:=1;
      while j<=n do
        begin
        mayor_g:=arreglo[j];
        repeat
          inc(j);
          if arreglo[j]>mayor_g then
            mayor_g:=arreglo[j];
        until (j mod k=1) or (j=n);
        grandes[h]:=mayor_g;
        inc(h);
        end;
      mayor_gs:=grandes[1];
      for j:=2 to h do
        if grandes[j]>mayor_gs then
          mayor_gs:=grandes[j];
      arreglo_final[i]:=mayor_gs;
      j:=1;
      flag:=false;
      while not flag do
        begin
        if arreglo[j]=mayor_gs then
          begin
          arreglo[j]:=neutro;
          flag:=true;
          end;
        inc(j);
        end;
      end;
    arreglo:=arreglo_final;
    write(#10,#13,'  Secuencia Clasificada!');
    muestra_vector(arreglo,n);
    readkey;
  end;
  {FIN procedimientos de ordenacion para arreglos}

{INICIO de llenado de archivo}
procedure bllena_aleatorio(var archBin:archReg; n:integer);
  var i:integer; aux:registros;
  begin
  randomize;
  rewrite(archBin);
  for i:=1 to n do
    begin
    aux.num:=trunc(random(10)*random(10));
    write(archBin,aux);
    end;
  end;
procedure bllena_ordenado(var archBin:archReg; n:integer);
  var cont:integer; aux,aux2:registros;
  begin
  randomize;
  rewrite(archBin);
  cont:=0;
  aux.num:=trunc(random(10)*random(10));
  write(archBin,aux);
  while cont<n do
    begin
    inc(cont);
     aux2:=aux;
    repeat
      aux.num:=aux.num+trunc(random(10));
    until aux.num>aux2.num;
    write(archBin,aux);
    end;
  end;
{FIN de llenado de archivo}

{INICIO de impresion de arreglos}
procedure muestra_archivo(var archBin:archReg);
var reg:registros;
begin
  reset(archBin);
  writeln('  [Elementos del archivo]'); write('   ');
  while not eof(archBin) do
    begin
    read(archBin,reg);
    write(reg.num,' ');
    end;
  writeln;
  writeln;
end;
procedure muestra_archivo2(var archBin:archReg);
var reg:registros;
begin
  reset(archBin);
  write('   ');
  while not eof(archBin) do
    begin
    read(archBin,reg);
    write(reg.num,' ');
    end;
  writeln;
end;
{FIN de impresion de arreglos}

procedure intercambia_b(var archBin:archReg; pos1,pos2:integer);
var reg1,reg2:registros;
begin
  dec(pos1);
  dec(pos2);
  seek(archBin,pos1); read(archBin,reg1);
  seek(archBin,pos2); read(archBin,reg2);
  seek(archBin,pos1); write(archBin,reg2);
  seek(archBin,pos2); write(archBin,reg1);
end;

  {INICIO procedimientos de busqueda para archivos binarios}
  procedure bb_secuencial(var archBin:archReg; n,elemento:integer);
  var hallado:boolean; reg:registros; cont:integer;
  begin
    reset(archBin);
    cont:=0;
    hallado:=false;
    while (not eof(archBin)) and (not hallado) do
      begin
      inc(cont);
      read(archBin,reg);
      if reg.num=elemento then
        hallado:=true;
      end;
    if hallado then
      writeln('  Elemento ',elemento,' encontrado en la posicion ',cont)
    else
      writeln('  Elemento ',elemento,' no hallado');
  end;

  procedure bb_binaria(var archBin:archReg; n,elemento:integer);
  var izq,der,cen:integer; salir:boolean; centro:registros;
  begin
    izq:=0;
    der:=n;
    salir:=false;
    while not salir do
      begin
      cen:=(izq+der) div 2;
      seek(archBin,cen);
      read(archBin,centro);
      if (elemento=centro.num) or (izq>=der) then
        salir:=true
      else
        if elemento>centro.num then
          izq:=cen+1
        else
          der:=cen-1;
      end;
    if elemento=centro.num then
      writeln('  Elemento ',elemento,' encontrado en la posicion ',cen)
    else
      writeln('  Elemento ',elemento,' no hallado');
  end;
  {FIN procedimientos de busqueda para archivos binarios}

  {INICIO procedimientos de ordenacion para archivos binarios}
  procedure ob_slinealsim(var archBin:archReg; n:integer);
  var i_ord,i_max,i,j:integer;
      neutro,menor,reg_i,reg_j,reg_i_max:registros;
      archAux:archReg;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_archivo(archBin);
    writeln('  [Procesamiento en arreglo auxiliar]');
    {Inicio del metodo}
    {Genera archivo Auxiliar}
    menor.num:=0;
    assign(archAux,'auxi.bin');
    rewrite(archAux);
    for i:=1 to n do
      write(archAux,menor);
    {Obtiene el valor neutro}
    reset(archBin);
    read(archBin,menor);
    for j:=2 to n do
      begin
      read(archBin,reg_j);
      if reg_j.num<menor.num then
        menor:=reg_j;
      end;
    neutro.num:=menor.num-1;
    {Procedimiento en si}
    i_ord:=n;
    for j:=n downto 1 do
      begin
      i_max:=1;
      for i:=1 to n do
        begin
        seek(archBin,i_max-1);
        read(archBin,reg_i_max);
        seek(archBin,i-1);
        read(archBin,reg_i);
        if (reg_i_max.num<reg_i.num) and (reg_i.num<>neutro.num) then
          i_max:=i;
        end;
      seek(archAux,i_ord-1);
      write(archAux,reg_i_max);
      seek(archBin,i_max-1);
      write(archBin,neutro);
      dec(i_ord);
      end;
    rewrite(archBin);
    reset(archAux);
    while not eof(archAux) do
      begin
      read(archAux,reg_i);
      write(archBin,reg_i);
      end;
    write(#10,#13,'  Secuencia Clasificada!');
    muestra_archivo(archBin);
    erase(archAux);
    readkey;
  end;

  procedure ob_slinealint(var archBin:archReg; n:integer);
  var i,j,i_menor:integer;
      reg_menor,reg_j:registros;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_archivo(archBin);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    for i:=1 to n-1 do
      begin
      i_menor:=i;
      seek(archBin,i_menor-1);
      read(archBin,reg_menor);
      for j:=i+1 to n do
        begin
        seek(archBin,j-1);
        read(archBin,reg_j);
        if reg_j.num<reg_menor.num then
          begin
          reg_menor:=reg_j;
          i_menor:=j;
          end;
        end;
      intercambia_b(archBin,i,i_menor);
      {Muestra proceso}
      if i=n-1 then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_archivo(archBin);
        end
      else
        muestra_archivo2(archBin);
      readkey;
      end;
  end;

  procedure ob_burbuja(var archBin:archReg; n:integer);
  var i,j:integer; reg_i,reg_j:registros;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_archivo(archBin);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    for i:=1 to n-1 do
      begin
      for j:=i+1 to n do
        begin
        seek(archBin,j-1); read(archBin,reg_j);
        seek(archBin,i-1); read(archBin,reg_i);
        if reg_j.num<reg_i.num then
          begin
          intercambia_b(archBin,i,j);
          end;
        end;
      {Muestra proceso}
      if i=n-1 then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_archivo(archBin);
        end
      else
        muestra_archivo2(archBin);
      readkey;
      end;
  end;

  procedure ob_bubble(var archBin:archReg; n:integer);
  var i,j:integer; reg_i,reg_j,reg_j_1:registros;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_archivo(archBin);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    for i:=1 to n-1 do
      begin
      for j:=n downto i+1 do
        begin
        seek(archBin,j-1); read(archBin,reg_j);
        seek(archBin,j-2); read(archBin,reg_j_1);
        if reg_j.num<reg_j_1.num then
          intercambia_b(archBin,j,j-1);
        end;
      {Muestra proceso}
      if i=n-1 then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_archivo(archBin);
        end
      else
        muestra_archivo2(archBin);
      readkey;
      end;
  end;

  procedure ob_shaker(var archBin:archReg; n:integer);
  var
    ultimo_inter,izquierda,derecha,i:integer;
    reg_i,reg_i_1,reg_j,reg_j_1:registros;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_archivo(archBin);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    ultimo_inter:=n;
    izquierda:=2;
    derecha:=n;
    repeat
      for i:=derecha downto izquierda do
        begin
        seek(archBin,i-1);
        read(archBin,reg_i);
        seek(archBin,i-2);
        read(archBin,reg_i_1);
        if reg_i.num<reg_i_1.num then
          begin
          intercambia_b(archBin,i,i-1);
          ultimo_inter:=i;
          end;
        end;
      izquierda:=ultimo_inter+1;
      for i:=izquierda to derecha do
        begin
        seek(archBin,i-1);
        read(archBin,reg_i);
        seek(archBin,i-2);
        read(archBin,reg_i_1);
        if reg_i.num<reg_i_1.num then
          begin
          intercambia_b(archBin,i,i-1);
          ultimo_inter:=i;
          end;
        end;
      derecha:=ultimo_inter-1;
      {Muestra proceso}
      if derecha<izquierda then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_archivo(archBin);
        end
      else
        muestra_archivo2(archBin);
      readkey;
    until derecha<izquierda;
  end;

  procedure ob_insertlin(var archBin:archReg; n:integer);
  var
    i,j:integer;
    reg_i,reg_j,reg_j_1,elemento:registros;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_archivo(archBin);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    for i:=2 to n do
      begin
      seek(archBin,i-1); read(archBin,reg_i);
      elemento:=reg_i;
      j:=i;
      seek(archBin,j-2); read(archBin,reg_j_1);
      while (j>1) and (elemento.num<reg_j_1.num) do
        begin
        reg_j:=reg_j_1;
        seek(archBin,j-1); write(archBin,reg_j);
        dec(j);
        if j<>1 then
          begin
          seek(archBin,j-2); read(archBin,reg_j_1);
          end;
        end;
      seek(archBin,j-1); write(archBin,elemento);
      {Muestra proceso}
      if i=n then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_archivo(archBin);
        end
      else
        muestra_archivo2(archBin);
      readkey;
      end;
  end;

  procedure ob_insertbin(var archBin:archReg; n:integer);
  var
    i,izquierda,derecha,medio,j:integer;
    elemento,reg_j,reg_j_1,reg_medio:registros;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_archivo(archBin);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    for i:=2 to n do
      begin
      seek(archBin,i-1);
      read(archBin,elemento);
      izquierda:=1;
      derecha:=i;
      while izquierda<derecha do
        begin
        medio:=(izquierda+derecha) div 2;
        seek(archBin,medio-1);
        read(archBin,reg_medio);
        if reg_medio.num<=elemento.num then
          izquierda:=medio+1
        else
          derecha:=medio;
        end;
      for j:=i downto derecha do
        if (j<>0) and (j<>1) then
        {para evitar caidas}
        begin
        seek(archBin,j-2);
        read(archBin,reg_j_1);
        seek(archBin,j-1);
        write(archBin,reg_j_1);
        end;
      seek(archBin,derecha-1);
      write(archBin,elemento);
      {Muestra proceso}
      if i=n then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_archivo(archBin);
        end
      else
        muestra_archivo2(archBin);
      readkey;
      end;
  end;

  procedure ob_shell(var archBin:archReg; n:integer);
  var counters: array[1..3] of integer;
    s, i, j, d, k: integer;
    f: boolean;
    reg_k,reg_i:registros;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_archivo(archBin);
    writeln('  Pulse tecla para cada corrida');
    {Inicio del metodo}
    counters[1]:=5;
    counters[2]:=3;
    counters[3]:=1;
    for s:=1 to 3 do
    begin
      d:=counters[s];
      for j:=d+1 to n do
      begin
        f:=false;
        i:=j-d;
        seek(archBin,j-1);
        read(archBin,reg_k);
        while (i>0) and not f do
          begin
          seek(archBin,i-1);
          read(archBin,reg_i);
          if reg_k.num>=reg_i.num then
            f:=true
          else
            begin
            seek(archBin,i+d-1);
            write(archBin,reg_i);
            i:=i-d;
            end;
          end;
        seek(archBin,i+d-1);
        write(archBin,reg_k);
      end;
      {Muestra proceso}
      if s=3 then
        begin
        write(#10,#13,'  Secuencia Clasificada!');
        muestra_archivo(archBin);
        end
      else
        muestra_archivo2(archBin);
      readkey;
    end;
  end;

  procedure ob_quicksort(var archBin:archReg; n:integer);
    procedure quick_sort(var archBin:archReg; izq,der: integer);
    var i, ultimo: integer; reg_i,reg_izq:registros;
    begin
      if izq<der then
      begin
        intercambia_b(archBin,izq,(izq+der) div 2);
        ultimo:=izq;
        for i:=izq+1 to der do
          begin
          seek(archBin,i-1);
          read(archBin,reg_i);
          seek(archBin,izq-1);
          read(archBin,reg_izq);
          if reg_i.num<reg_izq.num then
            begin
            inc(ultimo);
            intercambia_b(archBin,ultimo,i);
            end;
          end;
        intercambia_b(archBin,izq,ultimo);
        quick_sort(archBin,izq,ultimo-1);
        quick_sort(archBin,ultimo+1,der);
      end;
    end;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_archivo(archBin);
    writeln('  Procesamiento recursivo');
    {Inicio del metodo}
    quick_sort(archBin,1,n);
    write(#10,#13,'  Secuencia Clasificada!');
    muestra_archivo(archBin);
    readkey;
  end;

  procedure ob_ordindices(var archBin:archReg; n:integer);
  var
    i,j,aux:integer;
    archInd:archReg; reg,reg_i,reg_j,ind_i,ind_j:registros;
  begin
    assign(archInd,'auxi.bin');
    rewrite(archInd);
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_archivo(archBin);
    writeln('  [Procesamiento en arreglo auxiliar]');
    {Inicio del metodo}
    for i:=1 to n do
      begin
      reg.num:=i;
      write(archInd,reg);
      end;
    for i:=1 to n-1 do
      for j:=i+1 to n do
        begin
        seek(archInd,i-1); read(archInd,ind_i);
        seek(archBin,ind_i.num-1); read(archBin,reg_i);
        seek(archInd,j-1); read(archInd,ind_j);
        seek(archBin,ind_j.num-1); read(archBin,reg_j);
        if reg_i.num>reg_j.num then
          begin
          seek(archInd,i-1);
          write(archInd,ind_j);
          seek(archInd,j-1);
          write(archInd,ind_i);
          end;
        end;
    writeln(#10,#13,'  Secuencia Clasificada!  [Elementos del archivo]');
    write('   ');
    for i:=1 to n do
      begin
      seek(archInd,i-1);
      read(archInd,ind_i);
      seek(archBin,ind_i.num-1);
      read(archBin,reg_i);
      write(reg_i.num,' ');
      end;
    readkey;
    erase(archInd);
  end;

  procedure ob_scuadrat(var archBin:archReg; n:integer);
  var
    i,j,k,h:integer;
    menor,reg_i,reg_j,neutro,mayor_g,mayor_gs:registros;
    archivo_final,archGrandes:archReg;
    flag:boolean;
  begin
    {Muestra datos de origen}
    write('  Secuencia Original!');
    muestra_archivo(archBin);
    writeln('  [Procesamiento en arreglo auxiliar]');
    {Inicio del metodo}
    assign(archivo_final,'final.bin');
    assign(archGrandes,'grandes.bin');
    rewrite(archivo_final);
    rewrite(archGrandes);
    seek(archBin,0);
    read(archBin,menor);
    for j:=2 to n do
      begin
      seek(archBin,j-1);
      read(archBin,reg_j);
      if reg_j.num<menor.num then
        menor:=reg_j;
      end;
    neutro.num:=menor.num-1;
    k:=trunc(sqrt(n));
    for i:=1 to n do
      begin
      j:=1;
      h:=1;
      rewrite(archGrandes);
      while j<=n do
        begin
        seek(archBin,j-1);
        read(archBin,reg_j);
        mayor_g:=reg_j;
        while (j mod k<>0) and (j<n) do
          begin
          inc(j);
          seek(archBin,j-1);
          read(archBin,reg_j);
          if reg_j.num>mayor_g.num then
            mayor_g.num:=reg_j.num;
          end;
        inc(j);
        seek(archGrandes,h-1);
        write(archGrandes,mayor_g);
        inc(h);
        end;
      seek(archGrandes,0);
      read(archGrandes,mayor_gs);
      for j:=2 to h-1 do
        begin
        seek(archGrandes,j-1);
        read(archGrandes,reg_j);
        if reg_j.num>mayor_gs.num then
          mayor_gs:=reg_j;
        end;
      seek(archivo_final,i-1);
      write(archivo_final,mayor_gs);
      j:=1;
      flag:=false;
      while not flag do
        begin
        seek(archBin,j-1);
        read(archBin,reg_j);
        if reg_j.num=mayor_gs.num then
          begin
          seek(archBin,j-1);
          write(archBin,neutro);
          flag:=true;
          end;
        inc(j);
        end;
      end;
    rewrite(archBin);
    reset(archivo_final);
    while not eof(archivo_final) do
      begin
      read(archivo_final,reg_i);
      write(archBin,reg_i);
      end;
    write(#10,#13,'  Secuencia Clasificada!');
    muestra_archivo(archBin);
    erase(archivo_final);
    erase(archGrandes);
    readkey;
  end;
  {FIN procedimientos de ordenacion para archivos binarios}

end.