# 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.
LVL 1
Asked:
###### Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Commented:
Could this help you??

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
0
Commented:
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
0
Commented:
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.
0
Commented:
Dbruntons commment is correct. An error from my side :-)
0
Commented:
Here is the same example with a quicker sorting-method(Shellsort)

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;
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
{maybe some code here to get some data
into the array}

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}
end.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Commented:
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.
0
Author Commented:
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.

0
Commented:
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
0
Commented:
If you can't figure out anything wrong, could you post your source code here?
0
Systems EngineerCommented:
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,Final: MiLista;
ComEnc,AntEnc,ActEnc,FinEnc: 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.Apellido1;
Apellido2:=DatosNuevos.Apellido2;
Edad:=DatosNuevos.Edad;
Sexo:=DatosNuevos.Sexo;
Direccion:=DatosNuevos.Direccion;
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.Apellido1;
Apellido2:=DatosNuevos.Apellido2;
Edad:=DatosNuevos.Edad;
Sexo:=DatosNuevos.Sexo;
Direccion:=DatosNuevos.Direccion;
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(ListaRec) - 8);
Move(Act^,Ant^,SizeOf(ListaRec) - 8);
Move(Temp^,Act^,SizeOf(ListaRec) - 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,Actual);
Ap1:
If Anterior^.Apellido1 > Actual^.Apellido1 Then
CambiaLugar(Anterior,Actual);
Ap2:
If Anterior^.Apellido2 > Actual^.Apellido2 Then
CambiaLugar(Anterior,Actual);
Eda:
If Anterior^.Edad > Actual^.Edad Then
CambiaLugar(Anterior,Actual);
Sex:
If Anterior^.Sexo > Actual^.Sexo Then
CambiaLugar(Anterior,Actual);
Dir:
If Anterior^.Direccion > Actual^.Direccion Then
CambiaLugar(Anterior,Actual);
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(DondeEsta: 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,NombreArchivoLista);
{\$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,NombreArchivoLista);
{\$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(Byte(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(TipoOrdena(Byte(Key)-49),CadenaABuscar) Then
Begin
WriteLn;
WriteLn('La Cadena se encontro ',CuantasVeces,' Ves(ces) en los Records...');
ActEnc:=ComEnc;
While ActEnc <> Nil Do
Begin
VisualizaLista(ActEnc^.Puntero);
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.
0
Systems EngineerCommented:
Tiene algunos errores, hay que refinarlo...
0
Author Commented:
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.
0
Commented:
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
0
Author Commented:
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
0
Commented:
I would do my best :-)

Batalf
0
###### It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Pascal

From novice to tech pro — start learning today.