gsoldado
asked on
Sort a record
I need to sort an array of record wich has several fields, but it must be sorted in relation to one of them, wich must be a string.
Can anyone help me with the code please?
tanx.
Can anyone help me with the code please?
tanx.
The example above sort an Array of
this fields :
name : String[20];
age : integer;
hight : integer;
bases on the name-field.
I've typed this code right into this combobox. I could probably use a better/faster sorting method(Quick sort),but haven't source code on it where I'm sitting right now.
Batalf
this fields :
name : String[20];
age : integer;
hight : integer;
bases on the name-field.
I've typed this code right into this combobox. I could probably use a better/faster sorting method(Quick sort),but haven't source code on it where I'm sitting right now.
Batalf
The following line is incorrect
table[y+1]:=table;
It should be
table[y + 1] := tempvar;
The algorithm is crude but the question has been answered.
table[y+1]:=table;
It should be
table[y + 1] := tempvar;
The algorithm is crude but the question has been answered.
Dbruntons commment is correct. An error from my side :-)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Another sorting algorithm (false bubbling):
for i:=1 to 99 do
for j:=i+1 to 100 do
if table[j].name < table[i].name then
begin
temp :=table[i];
table[i]:=table[j];
table[j]:=temp;
end;
Of course, there are entire BOOKS that deal about sorting algorithm, but you have enough material here to do a good job.
for i:=1 to 99 do
for j:=i+1 to 100 do
if table[j].name < table[i].name then
begin
temp :=table[i];
table[i]:=table[j];
table[j]:=temp;
end;
Of course, there are entire BOOKS that deal about sorting algorithm, but you have enough material here to do a good job.
ASKER
Batalf: I'm testing your procedure, but I only get (when I load data in the array) ceros and blank spaces, I'm triying to find out why, if I can't find an answer I'll show the code I added to see if I'm the one making a mistake. Thanks for writing all that for me. Thanks all the others too, it's being very educative.
Have you tried both of the procedures?
I would check out the shellsort procedure a little bit to see if I can find any errors.
I think the first one I posted should work though.
Right ?
Regards
Batalf
I would check out the shellsort procedure a little bit to see if I can find any errors.
I think the first one I posted should work though.
Right ?
Regards
Batalf
If you can't figure out anything wrong, could you post your source code here?
Program BusquedaEnArray;
USES
CRT;
Const
ConstSexo: Array[0..1] Of String = ('Hombre','Mujer');
NombreArchivoLista = 'LISTA.REC';
CuantasVeces: LongInt = 0;
Type
TipoSexo = (Hombre,Mujer);
TipoOrdena = (Nom,Ap1,Ap2,Eda,Sex,Dir);
EncLista = ^ListaEncontro;
ListaEncontro = Record
Puntero: Pointer;
AEnc: EncLista;
SEnc: EncLista;
End;
MiLista = ^ListaRec;
ListaRec = Record
Nombre: String[20];
Apellido1: String[20];
Apellido2: String[20];
Edad: Byte;
Sexo: TipoSexo;
Direccion: String[40];
AntRec: MiLista;
SigRec: MiLista;
End;
Var
ArchivoLista: File Of ListaRec;
Comienzo,Anterior,Actual,F inal: MiLista;
ComEnc,AntEnc,ActEnc,FinEn c: EncLista;
CadenaABuscar: String;
Key: Char;
I: LongInt;
{ Function para contar el numero de records en la lista }
Function CuentaLista: LongInt;
Var
I: LongInt;
Begin
Actual:=Comienzo;
I:=0;
While Actual <> Nil Do
Begin
I:=I+1;
Actual:=Actual^.SigRec;
End;
CuentaLista:=I;
End;
{ Procedure para a¤adir records a la lista }
Procedure AnadeALaLista(DatosNuevos: ListaRec);
Begin
{ Establecer si no es la primera vez que hacemos la lista }
If Actual = NIL Then
Begin
New(Actual); { Obten memoria para los datos }
With Actual^ do { Llenado de los datos }
Begin
Nombre:=DatosNuevos.Nombre ;
Apellido1:=DatosNuevos.Ape llido1;
Apellido2:=DatosNuevos.Ape llido2;
Edad:=DatosNuevos.Edad;
Sexo:=DatosNuevos.Sexo;
Direccion:=DatosNuevos.Dir eccion;
SigRec:=NIL; { No hay mas registros arriba, apunta a NIL }
AntRec:=NIL { No hay mas registros abajo, apunta a NIL }
End;
Comienzo:=Actual;
Final:=Actual
End
Else { Esta no es la primer vez que a¤adimos registros }
Begin
New(Final);
Final^.AntRec:=Actual; {Actual <- Final}
Final^.SigRec:=NIL; {Final -> Nil}
Actual^.SigRec:=Final; {Actual -> Final}
Actual:=Final; {Actual:=Final}
With Actual^ do {Fill in the data}
Begin
Nombre:=DatosNuevos.Nombre ;
Apellido1:=DatosNuevos.Ape llido1;
Apellido2:=DatosNuevos.Ape llido2;
Edad:=DatosNuevos.Edad;
Sexo:=DatosNuevos.Sexo;
Direccion:=DatosNuevos.Dir eccion;
End
End
End;
{ Procedure para ordenar la lista usando el metodo de Burbuja }
Procedure OrdenaLista(QueOrdena: TipoOrdena);
Var
Index1,Index2: Integer;
MaxNum: Integer;
Procedure CambiaLugar(Var Ant,Act: MiLista);
Var
Temp: MiLista;
Begin
New(Temp);
Move(Ant^,Temp^,SizeOf(Lis taRec) - 8);
Move(Act^,Ant^,SizeOf(List aRec) - 8);
Move(Temp^,Act^,SizeOf(Lis taRec) - 8);
Dispose(Temp);
End;
Begin
MaxNum:=CuentaLista;
Anterior:=Comienzo;
Actual:=Final;
For Index1:=1 To MaxNum-1 Do
Begin
For Index2:=MaxNum DownTo Index1+1 Do
Begin
Case QueOrdena Of
Nom:
If Anterior^.Nombre > Actual^.Nombre Then
CambiaLugar(Anterior,Actua l);
Ap1:
If Anterior^.Apellido1 > Actual^.Apellido1 Then
CambiaLugar(Anterior,Actua l);
Ap2:
If Anterior^.Apellido2 > Actual^.Apellido2 Then
CambiaLugar(Anterior,Actua l);
Eda:
If Anterior^.Edad > Actual^.Edad Then
CambiaLugar(Anterior,Actua l);
Sex:
If Anterior^.Sexo > Actual^.Sexo Then
CambiaLugar(Anterior,Actua l);
Dir:
If Anterior^.Direccion > Actual^.Direccion Then
CambiaLugar(Anterior,Actua l);
End;
Actual:=Actual^.AntRec;
End;
Anterior:=Anterior^.SigRec ;
Actual:=Final;
End
End;
Procedure EliminaListaEncontro;
Begin
ActEnc:=ComEnc;
If ActEnc <> NIL Then
Begin
While ActEnc^.AEnc <> Nil Do
Begin
AntEnc:=ActEnc;
ActEnc:=ActEnc^.SEnc;
If AntEnc <> Nil Then
Dispose(AntEnc)
End;
Dispose(ActEnc)
End
End;
Procedure AnadeListaEncontro(DondeEs ta: Pointer);
Begin
If ActEnc = NIL Then
Begin
New(ActEnc);
With ActEnc^ do
Begin
Puntero:=DondeEsta;
SEnc:=NIL;
AEnc:=NIL
End;
ComEnc:=ActEnc;
FinEnc:=ActEnc
End
Else {Now this is not the first time}
Begin
New(FinEnc);
FinEnc^.AEnc:=ActEnc; {Current <- FinEnc}
FinEnc^.SEnc:=NIL; {FinEnc -> Nil}
ActEnc^.SEnc:=FinEnc; {Current -> FinEnc}
ActEnc:=FinEnc; {Current:=FinEnc}
With ActEnc^ do {Fill in the data}
Begin
Puntero:=DondeEsta;
End
End
End;
Function CadenaEncontrada(EnDonde: TipoOrdena; QueCadena: String): Boolean;
Var
SeEncontro: Boolean;
Begin
Actual:=Comienzo;
EliminaListaEncontro;
While Actual <> Nil Do
Begin
Case EnDonde Of
Nom:
If QueCadena = Actual^.Nombre Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces + 1;
AnadeListaEncontro(Actual)
End;
Ap1:
If QueCadena = Actual^.Apellido1 Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces + 1;
AnadeListaEncontro(Actual)
End;
Ap2:
If QueCadena = Actual^.Apellido2 Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces + 1;
AnadeListaEncontro(Actual)
End;
{Edad:
If QueCadena = Actual^.Sexo Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces + 1;
AnadeListaEncontro(Actual)
End;}
{Sex:
If QueCadena = Actual^.Sexo Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces + 1;
AnadeListaEncontro(Actual)
End;}
Dir:
If QueCadena = Actual^.Direccion Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces + 1;
AnadeListaEncontro(Actual)
End;
End;
Actual:=Actual^.SigRec;
End;
End;
Procedure DesasteDeTodo;
Begin
Actual:=Comienzo;
If Actual <> NIL Then
Begin
While Actual^.SigRec <> Nil Do
Begin
Anterior:=Actual;
Actual:=Actual^.SigRec;
If Anterior <> Nil Then
Dispose(Anterior)
End;
Dispose(Actual)
End
End;
Procedure LeeArchivo;
Var
Temp: ListaRec;
Begin
Assign(ArchivoLista,Nombre ArchivoLis ta);
{$I-} Reset(ArchivoLista); {$I+}
If IOResult <> 0 Then
Rewrite(ArchivoLista);
While Not EOF(ArchivoLista) Do
Begin
Read(ArchivoLista,Temp);
AnadeALaLista(Temp);
End;
Close(ArchivoLista);
End;
Procedure EscribeArchivo;
Begin
Assign(ArchivoLista,Nombre ArchivoLis ta);
{$I-} Reset(ArchivoLista); {$I+}
If IOResult <> 0 Then
Rewrite(ArchivoLista);
Actual:=Comienzo;
While Actual <> Nil Do
Begin
Write(ArchivoLista,Actual^ );
Actual:=Actual^.SigRec;
End;
Close(ArchivoLista);
End;
Procedure LlenaDatos;
Var
Temp: ListaRec;
T: String[1];
ST,Cod: Integer;
Begin
Write('Nombre: ');
ReadLn(Temp.Nombre);
Write('Apellido1: ');
ReadLn(Temp.Apellido1);
Write('Apellido2: ');
ReadLn(Temp.Apellido2);
Write('Edad: ');
ReadLn(Temp.Edad);
Repeat
Write('Sexo [0=Hombre/1=Mujer]');
ReadLn(T);
Val(T,ST,Cod)
Until ((Cod = 0) And (ST in [0..1]));
Temp.Sexo:=TipoSexo(ST);
Write('Direccion: ');
ReadLn(Temp.Direccion);
AnadeALaLista(Temp);
End;
Procedure VisualizaLista(PLista: Pointer);
Begin
With ListaRec(PLista^) Do
Begin
WriteLn('Nombre: ',Nombre);
WriteLn('Apellido1: ',Apellido1);
WriteLn('Apellido2: ',Apellido2);
WriteLn('Edad: ',Edad);
WriteLn('Sexo: ',ConstSexo[Byte(Sexo)]);
WriteLn('Direccion: ',Direccion);
WriteLn;
End;
End;
Begin
ClrScr;
WriteLn('Leyendo De Archivo ',NombreArchivoLista);
LeeArchivo;
Repeat
WriteLn('Presione Una Tecla para continuar [ESC=Salir]');
Write('A¤ade Ordena Busca Ver [ESC]');
WriteLn(#10#13);
Key:=ReadKey;
If Key=#0 Then
Key:=ReadKey;
Key:=UpCase(Key);
Case Key Of
'A':
Begin
LlenaDatos;
WriteLn(#10#13);
End;
'O':
Begin
Repeat
WriteLn('Ordenar Que??? ');
Write('1)Nombre 2)Apellido1 3)Apellido2 4)Edad 5)Sexo 6)Direccion ');
Key:=ReadKey;
Until Key in ['1'..'6'];
OrdenaLista(TipoOrdena(Byt e(Key)-49) );
WriteLn(#10#13);
End;
'B':
Begin
Repeat
WriteLn('Buscar Que??? ');
Write('1)Nombre 2)Apellido1 3)Apellido2 6)Direccion ');
Key:=ReadKey;
WriteLn;
Until Key in ['1'..'3','6'];
Write('Que Cadena Busca?: ');
ReadLn(CadenaABuscar);
CuantasVeces:=0;
If CadenaEncontrada(TipoOrden a(Byte(Key )-49),Cade naABuscar) Then
Begin
WriteLn;
WriteLn('La Cadena se encontro ',CuantasVeces,' Ves(ces) en los Records...');
ActEnc:=ComEnc;
While ActEnc <> Nil Do
Begin
VisualizaLista(ActEnc^.Pun tero);
ActEnc:=ActEnc^.SEnc;
ReadKey;
End;
End;
WriteLn(#10#13);
End;
'V':
Begin
Actual:=Comienzo;
While Actual <> Nil Do
Begin
VisualizaLista(Actual);
Actual:=Actual^.SigRec;
ReadKey;
End;
End;
End;
Until Key = #27;
WriteLn('Escribiendo a archivo ',NombreArchivoLista);
EscribeArchivo;
DesasteDeTodo;
End.
USES
CRT;
Const
ConstSexo: Array[0..1] Of String = ('Hombre','Mujer');
NombreArchivoLista = 'LISTA.REC';
CuantasVeces: LongInt = 0;
Type
TipoSexo = (Hombre,Mujer);
TipoOrdena = (Nom,Ap1,Ap2,Eda,Sex,Dir);
EncLista = ^ListaEncontro;
ListaEncontro = Record
Puntero: Pointer;
AEnc: EncLista;
SEnc: EncLista;
End;
MiLista = ^ListaRec;
ListaRec = Record
Nombre: String[20];
Apellido1: String[20];
Apellido2: String[20];
Edad: Byte;
Sexo: TipoSexo;
Direccion: String[40];
AntRec: MiLista;
SigRec: MiLista;
End;
Var
ArchivoLista: File Of ListaRec;
Comienzo,Anterior,Actual,F
ComEnc,AntEnc,ActEnc,FinEn
CadenaABuscar: String;
Key: Char;
I: LongInt;
{ Function para contar el numero de records en la lista }
Function CuentaLista: LongInt;
Var
I: LongInt;
Begin
Actual:=Comienzo;
I:=0;
While Actual <> Nil Do
Begin
I:=I+1;
Actual:=Actual^.SigRec;
End;
CuentaLista:=I;
End;
{ Procedure para a¤adir records a la lista }
Procedure AnadeALaLista(DatosNuevos:
Begin
{ Establecer si no es la primera vez que hacemos la lista }
If Actual = NIL Then
Begin
New(Actual); { Obten memoria para los datos }
With Actual^ do { Llenado de los datos }
Begin
Nombre:=DatosNuevos.Nombre
Apellido1:=DatosNuevos.Ape
Apellido2:=DatosNuevos.Ape
Edad:=DatosNuevos.Edad;
Sexo:=DatosNuevos.Sexo;
Direccion:=DatosNuevos.Dir
SigRec:=NIL; { No hay mas registros arriba, apunta a NIL }
AntRec:=NIL { No hay mas registros abajo, apunta a NIL }
End;
Comienzo:=Actual;
Final:=Actual
End
Else { Esta no es la primer vez que a¤adimos registros }
Begin
New(Final);
Final^.AntRec:=Actual; {Actual <- Final}
Final^.SigRec:=NIL; {Final -> Nil}
Actual^.SigRec:=Final; {Actual -> Final}
Actual:=Final; {Actual:=Final}
With Actual^ do {Fill in the data}
Begin
Nombre:=DatosNuevos.Nombre
Apellido1:=DatosNuevos.Ape
Apellido2:=DatosNuevos.Ape
Edad:=DatosNuevos.Edad;
Sexo:=DatosNuevos.Sexo;
Direccion:=DatosNuevos.Dir
End
End
End;
{ Procedure para ordenar la lista usando el metodo de Burbuja }
Procedure OrdenaLista(QueOrdena: TipoOrdena);
Var
Index1,Index2: Integer;
MaxNum: Integer;
Procedure CambiaLugar(Var Ant,Act: MiLista);
Var
Temp: MiLista;
Begin
New(Temp);
Move(Ant^,Temp^,SizeOf(Lis
Move(Act^,Ant^,SizeOf(List
Move(Temp^,Act^,SizeOf(Lis
Dispose(Temp);
End;
Begin
MaxNum:=CuentaLista;
Anterior:=Comienzo;
Actual:=Final;
For Index1:=1 To MaxNum-1 Do
Begin
For Index2:=MaxNum DownTo Index1+1 Do
Begin
Case QueOrdena Of
Nom:
If Anterior^.Nombre > Actual^.Nombre Then
CambiaLugar(Anterior,Actua
Ap1:
If Anterior^.Apellido1 > Actual^.Apellido1 Then
CambiaLugar(Anterior,Actua
Ap2:
If Anterior^.Apellido2 > Actual^.Apellido2 Then
CambiaLugar(Anterior,Actua
Eda:
If Anterior^.Edad > Actual^.Edad Then
CambiaLugar(Anterior,Actua
Sex:
If Anterior^.Sexo > Actual^.Sexo Then
CambiaLugar(Anterior,Actua
Dir:
If Anterior^.Direccion > Actual^.Direccion Then
CambiaLugar(Anterior,Actua
End;
Actual:=Actual^.AntRec;
End;
Anterior:=Anterior^.SigRec
Actual:=Final;
End
End;
Procedure EliminaListaEncontro;
Begin
ActEnc:=ComEnc;
If ActEnc <> NIL Then
Begin
While ActEnc^.AEnc <> Nil Do
Begin
AntEnc:=ActEnc;
ActEnc:=ActEnc^.SEnc;
If AntEnc <> Nil Then
Dispose(AntEnc)
End;
Dispose(ActEnc)
End
End;
Procedure AnadeListaEncontro(DondeEs
Begin
If ActEnc = NIL Then
Begin
New(ActEnc);
With ActEnc^ do
Begin
Puntero:=DondeEsta;
SEnc:=NIL;
AEnc:=NIL
End;
ComEnc:=ActEnc;
FinEnc:=ActEnc
End
Else {Now this is not the first time}
Begin
New(FinEnc);
FinEnc^.AEnc:=ActEnc; {Current <- FinEnc}
FinEnc^.SEnc:=NIL; {FinEnc -> Nil}
ActEnc^.SEnc:=FinEnc; {Current -> FinEnc}
ActEnc:=FinEnc; {Current:=FinEnc}
With ActEnc^ do {Fill in the data}
Begin
Puntero:=DondeEsta;
End
End
End;
Function CadenaEncontrada(EnDonde: TipoOrdena; QueCadena: String): Boolean;
Var
SeEncontro: Boolean;
Begin
Actual:=Comienzo;
EliminaListaEncontro;
While Actual <> Nil Do
Begin
Case EnDonde Of
Nom:
If QueCadena = Actual^.Nombre Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces
AnadeListaEncontro(Actual)
End;
Ap1:
If QueCadena = Actual^.Apellido1 Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces
AnadeListaEncontro(Actual)
End;
Ap2:
If QueCadena = Actual^.Apellido2 Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces
AnadeListaEncontro(Actual)
End;
{Edad:
If QueCadena = Actual^.Sexo Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces
AnadeListaEncontro(Actual)
End;}
{Sex:
If QueCadena = Actual^.Sexo Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces
AnadeListaEncontro(Actual)
End;}
Dir:
If QueCadena = Actual^.Direccion Then
Begin
SeEncontro:=True;
CuantasVeces:=CuantasVeces
AnadeListaEncontro(Actual)
End;
End;
Actual:=Actual^.SigRec;
End;
End;
Procedure DesasteDeTodo;
Begin
Actual:=Comienzo;
If Actual <> NIL Then
Begin
While Actual^.SigRec <> Nil Do
Begin
Anterior:=Actual;
Actual:=Actual^.SigRec;
If Anterior <> Nil Then
Dispose(Anterior)
End;
Dispose(Actual)
End
End;
Procedure LeeArchivo;
Var
Temp: ListaRec;
Begin
Assign(ArchivoLista,Nombre
{$I-} Reset(ArchivoLista); {$I+}
If IOResult <> 0 Then
Rewrite(ArchivoLista);
While Not EOF(ArchivoLista) Do
Begin
Read(ArchivoLista,Temp);
AnadeALaLista(Temp);
End;
Close(ArchivoLista);
End;
Procedure EscribeArchivo;
Begin
Assign(ArchivoLista,Nombre
{$I-} Reset(ArchivoLista); {$I+}
If IOResult <> 0 Then
Rewrite(ArchivoLista);
Actual:=Comienzo;
While Actual <> Nil Do
Begin
Write(ArchivoLista,Actual^
Actual:=Actual^.SigRec;
End;
Close(ArchivoLista);
End;
Procedure LlenaDatos;
Var
Temp: ListaRec;
T: String[1];
ST,Cod: Integer;
Begin
Write('Nombre: ');
ReadLn(Temp.Nombre);
Write('Apellido1: ');
ReadLn(Temp.Apellido1);
Write('Apellido2: ');
ReadLn(Temp.Apellido2);
Write('Edad: ');
ReadLn(Temp.Edad);
Repeat
Write('Sexo [0=Hombre/1=Mujer]');
ReadLn(T);
Val(T,ST,Cod)
Until ((Cod = 0) And (ST in [0..1]));
Temp.Sexo:=TipoSexo(ST);
Write('Direccion: ');
ReadLn(Temp.Direccion);
AnadeALaLista(Temp);
End;
Procedure VisualizaLista(PLista: Pointer);
Begin
With ListaRec(PLista^) Do
Begin
WriteLn('Nombre: ',Nombre);
WriteLn('Apellido1: ',Apellido1);
WriteLn('Apellido2: ',Apellido2);
WriteLn('Edad: ',Edad);
WriteLn('Sexo: ',ConstSexo[Byte(Sexo)]);
WriteLn('Direccion: ',Direccion);
WriteLn;
End;
End;
Begin
ClrScr;
WriteLn('Leyendo De Archivo ',NombreArchivoLista);
LeeArchivo;
Repeat
WriteLn('Presione Una Tecla para continuar [ESC=Salir]');
Write('A¤ade Ordena Busca Ver [ESC]');
WriteLn(#10#13);
Key:=ReadKey;
If Key=#0 Then
Key:=ReadKey;
Key:=UpCase(Key);
Case Key Of
'A':
Begin
LlenaDatos;
WriteLn(#10#13);
End;
'O':
Begin
Repeat
WriteLn('Ordenar Que??? ');
Write('1)Nombre 2)Apellido1 3)Apellido2 4)Edad 5)Sexo 6)Direccion ');
Key:=ReadKey;
Until Key in ['1'..'6'];
OrdenaLista(TipoOrdena(Byt
WriteLn(#10#13);
End;
'B':
Begin
Repeat
WriteLn('Buscar Que??? ');
Write('1)Nombre 2)Apellido1 3)Apellido2 6)Direccion ');
Key:=ReadKey;
WriteLn;
Until Key in ['1'..'3','6'];
Write('Que Cadena Busca?: ');
ReadLn(CadenaABuscar);
CuantasVeces:=0;
If CadenaEncontrada(TipoOrden
Begin
WriteLn;
WriteLn('La Cadena se encontro ',CuantasVeces,' Ves(ces) en los Records...');
ActEnc:=ComEnc;
While ActEnc <> Nil Do
Begin
VisualizaLista(ActEnc^.Pun
ActEnc:=ActEnc^.SEnc;
ReadKey;
End;
End;
WriteLn(#10#13);
End;
'V':
Begin
Actual:=Comienzo;
While Actual <> Nil Do
Begin
VisualizaLista(Actual);
Actual:=Actual^.SigRec;
ReadKey;
End;
End;
End;
Until Key = #27;
WriteLn('Escribiendo a archivo ',NombreArchivoLista);
EscribeArchivo;
DesasteDeTodo;
End.
Tiene algunos errores, hay que refinarlo...
ASKER
I'm not sure about what I did wrong, here is the code:
Const
N=100;{numbers of record}
TYPE
Tabletype = RECORD
name : String[20];
age : integer;
hight : integer;
end;
Tabletype2 = ARRAY[1..N] of tabletype;
var
table:tabletype2;
tempvar : tabletype;
a,i, offset, limit, switch: integer;
{it could be an idea to put the code below into a own procedure "Procedure Shellsort or something like that}
begin
for a:=1 to 4 do
begin
writeln('Inserte texto');
readln(table[a].name);
writeln('Inserte entero');
readln(table[a].age);
writeln('Inserte entero');
readln(table[a].hight);
end;
offset := N div 2;
while offset > 0 do
begin
limit := N - offset;
repeat
switch := 0;
for i := 1 to limit do
begin
if table[i].name > Table[i + offset].name then
begin
tempvar := table[i];
table[i]:=table[i+offset];
table[i+offset]:=tempvar;
switch := i;
end; {if}
end; {for}
limit := switch - offset;
until switch = 0;
offset := offset div 2;
end; {while}
for a:=1 to 4 do
begin
writeln(table[a].name);
writeln(table[a].age);
writeln(table[a].hight);
end;
end.
Const
N=100;{numbers of record}
TYPE
Tabletype = RECORD
name : String[20];
age : integer;
hight : integer;
end;
Tabletype2 = ARRAY[1..N] of tabletype;
var
table:tabletype2;
tempvar : tabletype;
a,i, offset, limit, switch: integer;
{it could be an idea to put the code below into a own procedure "Procedure Shellsort or something like that}
begin
for a:=1 to 4 do
begin
writeln('Inserte texto');
readln(table[a].name);
writeln('Inserte entero');
readln(table[a].age);
writeln('Inserte entero');
readln(table[a].hight);
end;
offset := N div 2;
while offset > 0 do
begin
limit := N - offset;
repeat
switch := 0;
for i := 1 to limit do
begin
if table[i].name > Table[i + offset].name then
begin
tempvar := table[i];
table[i]:=table[i+offset];
table[i+offset]:=tempvar;
switch := i;
end; {if}
end; {for}
limit := switch - offset;
until switch = 0;
offset := offset div 2;
end; {while}
for a:=1 to 4 do
begin
writeln(table[a].name);
writeln(table[a].age);
writeln(table[a].hight);
end;
end.
I think this one would work.
The problem was the Const N. It was
set to 100. Therefore, your sorting was wrong. Your 4 records was sorted with 96 blank records.
The code below works better. The N is there declared as a variable(which could change from time to time)
PROGRAM sorting;
USES
Crt;
TYPE
Tabletype = RECORD
name : String[20];
age : integer;
hight : integer;
end;
Tabletype2 = ARRAY[1..100] of tabletype;
var
table:tabletype2;
tempvar : tabletype;
a,i, offset, limit, switch: integer;
n : integer;
{it could be an idea to put the code below into a own procedure "Procedure Shellsort or something like that}
begin
writeln('Numbers of records ?');
Readln(N);
for a:=1 to N do
begin
writeln('Inserte texto');
readln(table[a].name);
writeln('Inserte entero');
readln(table[a].age);
writeln('Inserte entero');
readln(table[a].hight);
end;
offset := N div 2;
while offset > 0 do
begin
limit := N - offset;
repeat
switch := 0;
for i := 1 to limit do
begin
if table[i].name > Table[i + offset].name then
begin
tempvar := table[i];
table[i]:=table[i+offset];
table[i+offset]:=tempvar;
switch := i;
end; {if}
end; {for}
limit := switch - offset;
until switch = 0;
offset := offset div 2;
end; {while}
for a:=1 to 4 do
begin
writeln(table[a].name);
writeln(table[a].age);
writeln(table[a].hight);
end;
end.
Best Regards
Batalf
The problem was the Const N. It was
set to 100. Therefore, your sorting was wrong. Your 4 records was sorted with 96 blank records.
The code below works better. The N is there declared as a variable(which could change from time to time)
PROGRAM sorting;
USES
Crt;
TYPE
Tabletype = RECORD
name : String[20];
age : integer;
hight : integer;
end;
Tabletype2 = ARRAY[1..100] of tabletype;
var
table:tabletype2;
tempvar : tabletype;
a,i, offset, limit, switch: integer;
n : integer;
{it could be an idea to put the code below into a own procedure "Procedure Shellsort or something like that}
begin
writeln('Numbers of records ?');
Readln(N);
for a:=1 to N do
begin
writeln('Inserte texto');
readln(table[a].name);
writeln('Inserte entero');
readln(table[a].age);
writeln('Inserte entero');
readln(table[a].hight);
end;
offset := N div 2;
while offset > 0 do
begin
limit := N - offset;
repeat
switch := 0;
for i := 1 to limit do
begin
if table[i].name > Table[i + offset].name then
begin
tempvar := table[i];
table[i]:=table[i+offset];
table[i+offset]:=tempvar;
switch := i;
end; {if}
end; {for}
limit := switch - offset;
until switch = 0;
offset := offset div 2;
end; {while}
for a:=1 to 4 do
begin
writeln(table[a].name);
writeln(table[a].age);
writeln(table[a].hight);
end;
end.
Best Regards
Batalf
ASKER
Thanks man, really helpful, can I count on you if somethin goes wrong with it ahead? If not there is no problem you really helped a lot by now.
Thanks to all the other ones who wrote, was very informative.
Alex
Thanks to all the other ones who wrote, was very informative.
Alex
I would do my best :-)
Batalf
Batalf
Example :
Var
Tabletype = RECORD
name : String[20];
age : integer;
hight : integer;
end;
Tabletype2 = ARRAY[1..100] of tabletype;
var
table:tabletype2;
tempvar : tabletype;
procedure sorting;
var
x, y : integer;
begin
for x:=1 to 99 do
for y:=1 to 99 do
if table[y].name>
table[y+1].name then
begin
tempvar :=table[y];
table[y]:=table[y+1];
table[y+1]:=table;
end;
end;
end;
end;
....
....
...
begin
.......
end.
Regards
Batalf