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?
 
BatalfConnect With a Mentor 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
 
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
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

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

From novice to tech pro — start learning today.