Ver Mensaje Individual
  #3 (permalink)  
Antiguo 15/09/2003, 18:03
Avatar de BrujoNic
BrujoNic
Super Moderador
 
Fecha de Ingreso: noviembre-2001
Ubicación: Costa Rica/Nicaragua
Mensajes: 16.935
Antigüedad: 22 años, 5 meses
Puntos: 655
{************************************************* **************************}
{ METODOS DE ORDENAMIENTO }
{ }
{ 3 Algoritmos de ordenamiento, Burbuja, Seleccion y Interseccion. Trabajan }
{ sobre vectores de 1 dimension ordenandolos de menor a mayor, la cantidad }
{ de elementos de los vectores esta controlada por la constante N donde N }
{ puede tomar cualquier valor entero. Una forma de ver como trabajan estos }
{ algoritmos es usar el Debug de TPascal agregando la variable A(el vector) }
{ y observar como se va ordenando de a poco nuestro vector. }
{ }
{Mauricio ([email protected]) }
{Pd: no se pierdan el Debug que es lo mas!!! }
{************************************************* **************************}

program Ordenamiento;

uses crt;

const
N = 5;
type
TipoArray = Array [1 .. N] of byte;

var a:tipoarray;
i,j:byte;
opc:char;
salir:boolean;


procedure Cambiar (var a,b:byte);
var aux:byte;

begin
aux:= a;
a:= b;
b:= aux
end;

procedure Cargar(var A:TipoArray);
var i:byte;
begin
for i:=1 to N do
begin
write('Ingrese la coordenada ',i,': ');
readln(a[i]);
end;
end;


procedure Burbuja(var A:TipoArray);
var i,j:byte;

begin
for j:=1 to (N-1) do
for i:=1 to (N-1) do
if (A[i] > A[i+1]) then Cambiar(A[i],A[i+1])
end;



procedure Seleccion(var A: TipoArray);
var Recorrido,j:byte;

begin
for Recorrido:= 1 to N-1 do
for J :=Recorrido+1 to N do
If (A[Recorrido]>A[J]) then Cambiar(A[Recorrido],A[J])
end;


procedure Interseccion (var A:TipoArray);
var Indice,K,Aux:byte;
Hallado:Boolean;

begin
For Indice:= 2 to N do
begin
Aux:= A[Indice];
K:=Indice-1;
Hallado:=false;
While not Hallado and (K>0) do
If (A[K]>Aux) then
begin
A[K+1]:=A[K];
K:=K-1;
end
else Hallado:=true;
If Hallado then A [K+1]:=Aux
else A[1]:= Aux
end
end;



procedure Imprime(A:TipoArray);
var i:byte;
begin
write('[ ');
for i:=1 to N do write(A[i],' ');
writeln(']');
end;



begin
clrscr;
writeln(' TIPOS DE ORDENAMIENTO');
writeln;
Cargar(A);
writeln;
writeln('Seleccione el tipo de Ordenamiento: ');
writeln(' 1.Burbuja');
writeln(' 2.Selecci¢n');
writeln(' 3.Intersecci¢n');
writeln;
repeat
write(' Opc:');
readln(opc);
if (opc='1') or (opc='2') or (opc='3') then
salir:=true else salir:=false;
until salir;
case opc of
'1': Burbuja(A);
'2': Seleccion(A);
'3': Interseccion(A);
end;
Imprime(A);
readkey;
end.

Tomado de Código Fuente Pascal.
__________________
La tecnología está para ayudarnos. No comprendo el porqué con esa ayuda, la gente escribe TAN MAL.
NO PERDAMOS NUESTRO LINDO IDIOMA ESPAÑOL