Link to home
Start Free TrialLog in
Avatar of gsoldado
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.
Avatar of Batalf
Batalf
Flag of United States of America image

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
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
Avatar of dbrunton
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.
Dbruntons commment is correct. An error from my side :-)
ASKER CERTIFIED SOLUTION
Avatar of Batalf
Batalf
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of vikiing
vikiing

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.
Avatar of gsoldado

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
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,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.
Tiene algunos errores, hay que refinarlo...
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.
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
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
I would do my best :-)

Batalf