Hola ahora el problema que tengo es que no ordena el vector te paso el programa principal
Program ordenacion01 ;
Uses
Crt,OrdInt;
Const
N = 14; {Cantidad de datos a ordenar}
Rango = 10000; {Rango maximo de valores a ser generados aleatoriamente}
Type
ArrayType = array[1..N] of Integer;
Var
Data: ArrayType;
D: Integer;
Cad:String;
(*--------------------------------------------------------------------*)
Procedure GetSortMethod (var D:Integer);
Begin
ClrScr;
WriteLn;
WriteLn(' Seleccione el metodo de ordenacion: ');
WriteLn;
WriteLn(' 0- Cargar datos aleatoriamente');
WriteLn(' 1- Metodo de seleccion ');
WriteLn(' 2- Metodo de insercion ');
WriteLn(' 3- Metodo de burbujeo ');
WriteLn(' 4- Metodo "Shake Sort" ');
WriteLn(' 5- Metodo "Heap Sort" ');
WriteLn(' 6- Metodo "Quick Sort" ');
WriteLn(' 7- Metodo "Shell Sort" ');
WriteLn(' 8- Metodo "Merge Sort" ');
WriteLn(' 9- Mostrar los datos ');
WriteLn(' 10- Salir de este programa');
WriteLn;
WriteLn;
ReadLn(D);
End;
Procedure LoadList(Var Data: ArrayType; N:Integer);
Var
I: Integer;
Begin
For I := 1 To N Do
Data[I] := Random(Rango)
End;
Procedure ShowVectorItem(Data: ArrayType; N:Integer);
Var
I: Integer;
Begin
ClrScr;
Writeln('Item: ');
Writeln;
For I := 1 To N Do
Write(Data[I]:5);
WriteLn;
Readln;
End;
Procedure Menu(Var Data: ArrayType; N,D : Integer);
Begin
Case D Of
0: LoadList(Data,N);
1: StrSelectSort(Data, N);
2: StrInsert(Data, N);
3: BubbleSort(Data, N);
4: ShakeSort(Data, N);
5: HeapSort(Data, N);
6: QuickSort(Data, N);
7: ShellSort(Data, N);
8: MergeSort(Data, 1, N);
9: ShowVectorItem(Data,N);
10:writeln ('Nos vemos...');
Else
WriteLn('El valor ingresado no es valido.')
End
End;
Begin
Repeat
GetSortMethod(D);
Menu(Data, N,D);
WriteLn('Presione ENTER para continuar...');
ReadLn;
Until D=10;
End.
y esta es la unit:
unit OrdInt;
interface
type
ArrayType=array[1..10]of integer;
procedure MergeSort(var Data:ArrayType;I,J:integer);
procedure HeapSort(var Data:ArrayType;NUMElementS:integer);
procedure StrInsert(var X:ArrayType;N:integer);
procedure ShellSort(var A:ArrayType;N:integer);
procedure BubbleSort(var X:ArrayType;N:integer);
procedure ShakeSort(var X:ArrayType; N:integer);
procedure QuickSort(var List:ArrayType;N:integer);
procedure StrSelectSort(var X:ArrayType;N:integer);
implementation
Procedure Swap(Var X, Y : Integer);
Var
Temp: Integer;
Begin
Temp:= X;
X:= Y;
Y:= Temp
End;
(*------------------------- M E R G E S O R T ---------------------*)
Procedure Intercalar(Var Data: ArrayType; Izq,Mitad,Der: Integer);
Var B: ArrayType;
I,J,K: Integer;
Begin
I:= Mitad+1;
While I > Izq Do
Begin
B[I-1]:= Data[I-1];
Dec(I);
End;
J:= Mitad;
While J < Der Do
Begin
B[Der+Mitad-J]:= Data[J+1];
Inc(J);
End;
For K:= Izq To Der Do
If B[I] < B[J] Then
Begin
Data[K]:= B[I];
Inc(I);
End
Else
Begin
Data[K]:= B[J];
Dec(J);
End;
End;
Procedure MergeSort(Var Data: ArrayType; I,J: Integer);
Var Mitad: Integer;
Begin
If J > I Then
Begin
Mitad:= (I+J) Div 2;
MergeSort(Data,I,Mitad);
MergeSort(Data,Mitad+1,J);
Intercalar(Data,I,Mitad,J);
End;
End;
(*-------------------------- H E A P S O R T -----------------------*)
Procedure ReHeapDown(Var HEAPData : ArrayType; Root, Bottom : Integer);
Var
HeapOk: Boolean;
MaxChild: Integer;
Begin
HeapOk:= False;
While (Root * 2 <= Bottom)
And Not HeapOk Do
Begin
If (Root * 2 = Bottom) Then
MaxChild:= Root * 2
else
If (HEAPData[Root * 2] > HEAPData[Root * 2 + 1]) Then
MaxChild:= Root * 2
else
MaxChild:= Root * 2 + 1;
If (HEAPData[Root] < HEAPData[MaxChild]) Then
Begin
Swap(HEAPData[Root], HEAPData[MaxChild]);
Root:= MaxChild
End
Else
HeapOk:= True
End
End;
Procedure HeapSort(Var Data : ArrayType; NUMElementS : Integer);
Var
NodeIndex: Integer;
Begin
For NodeIndex:= (NUMElementS Div 2) Downto 1 Do
ReHeapDown(Data, NodeIndex, NUMElementS);
For NodeIndex := NUMElementS Downto 2 Do
Begin
Swap(Data[1], Data[NodeIndex]);
ReHeapDown(Data, 1, NodeIndex - 1);
End
End;
(*-------------------------- I N S E R T S O R T -------------------*)
Procedure StrInsert(Var X : ArrayType; N : Integer);
Var
J,
K,
Y: Integer;
Found: Boolean;
Begin
For J := 2 To N Do
Begin
Y := X[J];
K := J - 1;
Found := false;
While (K >= 1)
And (Not Found) Do
If (Y < X[K]) Then
Begin
X[K + 1] := X[K];
K := K - 1
End
else
Found := true;
X[K + 1] := Y;
End
End;
(*-------------------------- S H E L L S O R T ---------------------*)
Procedure ShellSort(Var A : ArrayType; N : Integer);
Var
Done: Boolean;
Jump,
I,
J : Integer;
Begin
Jump := N;
While (Jump > 1) Do
Begin
Jump := Jump Div 2;
Repeat
Done := true;
For J := 1 To (N - Jump) Do
Begin
I := J + Jump;
If (A[J] > A[I]) Then
Begin
Swap(A[J], A[I]);
Done := false
End;
End;
Until Done;
End
End;
(*-------------------------- B U B B L E S O R T -------------------*)
Procedure BubbleSort(Var X : ArrayType; N : Integer);
Var
I,
J : Integer;
Begin
For I := 2 To N Do
Begin
For J := N Downto I Do
If (X[J] < X[J - 1]) Then
Swap(X[J - 1], X[J]);
End
End;
(*-------------------------- S H A K E S O R T ---------------------*)
Procedure ShakeSort(Var X : ArrayType; N : Integer);
Var
L,
R,
K,
J : Integer;
Begin
L := 2;
R := N;
K := N;
Repeat
For J := R Downto L Do
If (X[J] < X[J - 1]) Then
Begin
Swap(X[J], X[J - 1]);
K := J
End;
L := K + 1;
For J := L To R Do
If (X[J] < X[J - 1]) Then
Begin
Swap(X[J], X[J - 1]);
K := J
End;
R := K - 1;
Until L >= R
End;
(*-------------------------- Q U I C K S O R T ---------------------*)
Procedure Partition(Var A : ArrayType; First, Last : Integer);
Var
Right,
Left : Integer;
V : Integer;
Begin
V := A[(First + Last) Div 2];
Right := First;
Left := Last;
Repeat
While (A[Right] < V) Do
Right := Right + 1;
While (A[Left] > V) Do
Left := Left - 1;
If (Right <= Left) Then
Begin
Swap(A[Right], A[Left]);
Right := Right + 1;
Left := Left - 1
End;
Until Right > Left;
If (First < Left) Then
Partition(A, First, Left);
If (Right < Last) Then
Partition(A, Right, Last)
End;
Procedure QuickSort(Var List : ArrayType; N : Integer);
Var
First,
Last : Integer;
Begin
First := 1;
Last := N;
If (First < Last) Then
Partition(List, First, Last)
End;
(*-------------------------- S E L E C T S O R T -------------------*)
Procedure StrSelectSort(Var X : ArrayType; N : Integer);
Var
I,
J,
K,
Y : Integer;
Begin
For I := 1 To N - 1 Do
Begin
K := I;
Y := X[I];
For J := (I + 1) To N Do
If (X[J] < Y) Then
Begin
K := J;
Y := X[J]
End;
X[K] := X[I];
X[I] := Y;
End
End;
(*--------------------------------------------------------------------*)
end.
Que puede ser para que no ordene el vector ingresado? muchas gracias por la ayuda