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
gsoldadoAsked:
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.

BatalfCommented:
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
BatalfCommented:
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
dbruntonCommented:
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
Cloud Class® Course: Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

BatalfCommented:
Dbruntons commment is correct. An error from my side :-)
0
BatalfCommented:
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.

Start your 7-day free trial
vikiingCommented:
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
gsoldadoAuthor 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
BatalfCommented:
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
BatalfCommented:
If you can't figure out anything wrong, could you post your source code here?
0
My name is MudSystems 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
My name is MudSystems EngineerCommented:
Tiene algunos errores, hay que refinarlo...
0
gsoldadoAuthor 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
BatalfCommented:
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
gsoldadoAuthor 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
BatalfCommented:
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.