?
Solved

Sorting TList with Previous ID ?

Posted on 2003-03-31
11
Medium Priority
?
274 Views
Last Modified: 2010-04-06
I would like to sort a List of records, but i didn't have a SortID i have the ID of the previous element,
What sorting i best for this (fastest and easiest)

my class
TTest = class
  ID : integer;
  PrevID : integer;   // This is the ID of the Previous Element or 0 if first element
end;

TTestList = class(TList)

  procedure SortIT;
end;
0
Comment
Question by:Dev6
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
  • 2
11 Comments
 
LVL 9

Expert Comment

by:mocarts
ID: 8241390
what is ID? index in list?
by what field do you want to sort?
mo.
0
 

Author Comment

by:Dev6
ID: 8241431
It is a class,  which is loaded from the DB.

ID is a unique integer (not the index - it's the index of the DB Primary Key)
PrevID is the ID of the previous Class.

for example

ID   PREVID  
1    3
3    2
2    7
8    0
7    8
4    1


Sorted List :
ID PREVID
8    0
7    8
2    7
3    2
1    3
4    1
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 8244134
a sample app

unit object_sort_u;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,
  Contnrs;  //must be added (for d7)

type
  TTestList = class(TObjectList);  //better in this case

  TTest = class
     ID : integer;
     PrevID : integer;   // This is the ID of the Previous Element or 0 if first element
  public
    constructor Create(AID, APrevID : Integer); OverLoad;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    FTestList : TTestList;
    procedure PrintOut;
    Procedure FillRandom;
  public
    { Public declarations }
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

//Overloaded TTest Creator
constructor TTest.Create(AID, APrevID : Integer);
begin
  Inherited Create;
  ID := AID;
  PrevID := APrevID;
end;

//Form Creator-Event
procedure TForm1.FormCreate(Sender: TObject);
begin
  FTestList := TTestList.Create(True);
end;

//Form Destructor-Event
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FTestList.Free;
end;

//Display List
procedure TForm1.PrintOut;
var i : Integer;
begin
  Memo1.Lines.Add('');
  Memo1.Lines.Add('ID'+#9+'PrevID');
  for i := 0 to FTestList.Count-1 do
    if (FTestList[i] is TTest) then
      Memo1.Lines.Add(intToStr(TTest(FTestList[i]).ID)+#9+
                      intToStr(TTest(FTestList[i]).PrevID));
end;

//Fill List
Procedure TForm1.FillRandom;
var i : Integer;
begin
  FTestList.Clear;
  for i := 1 to 10 do
    FTestList.Add(TTest.Create(Trunc(Random(10)),Trunc(Random(10))));
end;

//Fill and Print unsorted
procedure TForm1.Button1Click(Sender: TObject);
begin
  FillRandom;
  PrintOut;
end;

//Sorting Procs
function SortByID(Item1, Item2: Pointer): Integer;
begin
  result := 0;
  if (TObject(Item1) is TTest) and
     (TObject(Item2) is TTest) then
    If      TTest(Item1).ID < TTest(Item2).ID then Result := -1
    else If TTest(Item1).ID > TTest(Item2).ID then Result := 1
    //equal -> check PrevID
    else if TTest(Item1).PrevID < TTest(Item2).PrevID then Result := -1
    else If TTest(Item1).PrevID > TTest(Item2).PrevID then Result := 1;
end;

function SortByPrevID(Item1, Item2: Pointer): Integer;
begin
  result := 0;
  if (TObject(Item1) is TTest) and
     (TObject(Item2) is TTest) then
    If      TTest(Item1).PrevID < TTest(Item2).PrevID then Result := -1
    else If TTest(Item1).PrevID > TTest(Item2).PrevID then Result := 1
    //equal -> check ID
    else if TTest(Item1).ID < TTest(Item2).ID then Result := -1
    else If TTest(Item1).ID > TTest(Item2).ID then Result := 1;
end;

//sort by ID and PrintOut
procedure TForm1.Button2Click(Sender: TObject);
begin
  FTestList.Sort(@SortByID);
  PrintOut;
end;

//sort by PrevID and PrintOut
procedure TForm1.Button3Click(Sender: TObject);
begin
  FTestList.Sort(@SortByPrevID);
  PrintOut;
end;

end.

hope this helps

meikl ;-)
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:Dev6
ID: 8244192
No, that's not what i want !

It should not be sorted by PrevID.
Please se my example :

Sorted List :
ID PREVID
8    0
7    8
2    7
3    2
1    3
4    1

with your unit i get
ID PREVID
8    0
4    1
3    2
1    3
2    7
7    8

0
 

Author Comment

by:Dev6
ID: 8244221
an example of the actual code (and it's realy bad code !)
Fcontainer is the List which holds the data ...

    lastEntry   := 0;
    while (doneThis > 0) and (FContainer.Count > 0) do begin
        doneThis    := 0;
        i           := 0;
        while i < FContainer.Count do begin
            temp    := FContainer[i];
            AddThis := FALSE;
            if (temp.ID = temp.PrevID) or (temp.PrevID = 0) then AddThis    := TRUE
            else if temp.PrevID = lastEntry then AddThis    := TRUE;
            if AddThis then begin
                FContainer.Delete(i);
                listNew.Add(temp);
                inc(doneThis);
                lastEntry   := temp.ID;
            end
            else inc(i);
        end;
    end;
    for i:=0 to FContainer.Count-1 do
        listNew.Add(FContainer[i]);
    FContainer.Assign(listNew);
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 8244264
slight changes

unit object_sort_u;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,
  Contnrs;  //must be added (for d7)

type
  TTestList = class(TObjectList);  //better in this case

  TTest = class
     ID : integer;
     PrevID : integer;   // This is the ID of the Previous Element or 0 if first element
  public
    constructor Create(AID, APrevID : Integer); OverLoad;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    FTestList : TTestList;
    procedure PrintOut;
    Procedure FillRandom;
  public
    { Public declarations }
  end;


var
  Form1: TForm1;

implementation

{$R *.dfm}

//Overloaded TTest Creator
constructor TTest.Create(AID, APrevID : Integer);
begin
  Inherited Create;
  ID := AID;
  PrevID := APrevID;
end;

//Form Creator-Event
procedure TForm1.FormCreate(Sender: TObject);
begin
  FTestList := TTestList.Create(True);
end;

//Form Destructor-Event
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FTestList.Free;
end;

//Display List
procedure TForm1.PrintOut;
var i : Integer;
begin
  Memo1.Lines.Add('');
  Memo1.Lines.Add('ID'+#9+'PrevID');
  for i := 0 to FTestList.Count-1 do
    if (FTestList[i] is TTest) then
      Memo1.Lines.Add(intToStr(TTest(FTestList[i]).ID)+#9+
                      intToStr(TTest(FTestList[i]).PrevID));
end;

//Fill List
Procedure TForm1.FillRandom;
var i : Integer;
begin
  FTestList.Clear;
  for i := 1 to 10 do
    FTestList.Add(TTest.Create(Trunc(Random(10)),Trunc(Random(10))));
end;

//Fill and Print unsorted
procedure TForm1.Button1Click(Sender: TObject);
begin
  FillRandom;
  PrintOut;
end;

//special mapping for Dev6, who will not get headache about its problem
Function MapId(AInt : Integer) : Integer;
begin
  result := AInt;
  if AInt = 0 then Result := MaxLongInt - 1;
end;



//Sorting Procs
function SortByID(Item1, Item2: Pointer): Integer;
var
  vID1, vID2, vPrevID1, vPrevID2 : Integer;
begin
  result := 0;
  if (TObject(Item1) is TTest) and
     (TObject(Item2) is TTest) then
  begin
    vID1 := MapID(TTest(Item1).ID);
    vID2 := MapID(TTest(Item2).ID);
    vPrevID1 := MapID(TTest(Item1).PrevID);
    vPrevID2 := MapID(TTest(Item2).PrevID);
    if      vID1 < vID2 then Result := -1
    else If vID1 > vID2 then Result := 1
    //equal -> check ID
    else If vPrevID1 < vPrevID2 then Result := -1
    else If vPrevID1 > vPrevID2 then Result := 1;
  end;
end;


function SortByPrevID(Item1, Item2: Pointer): Integer;
var
  vID1, vID2, vPrevID1, vPrevID2 : Integer;
begin
  result := 0;
  if (TObject(Item1) is TTest) and
     (TObject(Item2) is TTest) then
  begin
    vID1 := MapID(TTest(Item1).ID);
    vID2 := MapID(TTest(Item2).ID);
    vPrevID1 := MapID(TTest(Item1).PrevID);
    vPrevID2 := MapID(TTest(Item2).PrevID);

    //speciality switch to reverse
    //for Dev6, who will not get headache about its problem
    If      vPrevID1 > vPrevID2 then Result := -1
    else If vPrevID1 < vPrevID2 then Result := 1
    //equal -> check ID
    else if vID1 < vID2 then Result := -1
    else If vID1 > vID2 then Result := 1;
  end;
end;

//sort by ID and PrintOut
procedure TForm1.Button2Click(Sender: TObject);
begin
  FTestList.Sort(@SortByID);
  PrintOut;
end;

//sort by PrevID and PrintOut
procedure TForm1.Button3Click(Sender: TObject);
begin
  FTestList.Sort(@SortByPrevID);
  PrintOut;
end;

end.

meikl ;-)
0
 

Author Comment

by:Dev6
ID: 8244323
No, it didn't work.

Please try :
procedure TForm1.Button4Click(Sender: TObject);
begin
    FTestList.Clear;
    FTestList.Add(TTest.Create(1, 3));
    FTestList.Add(TTest.Create(3, 2));
    FTestList.Add(TTest.Create(2, 7));
    FTestList.Add(TTest.Create(8, 0));
    FTestList.Add(TTest.Create(7, 8));
    FTestList.Add(TTest.Create(4, 1));
    PrintOut;
    FTestList.Sort(@SortByPrevID);
    PrintOut;
end;

The Result is :

ID     PrevID
1     3
3     2
2     7
8     0
7     8
4     1

ID     PrevID      but should be :
8     0           8  0
7     8           7  8
2     7           2  7
1     3           3  2  !!!!!
3     2           1  3  !!!!!
4     1           4  1

(1) in your function i get the item (1, 3) after the item (2, 7) but this item is not the Previous of (1, 3) ...
0
 
LVL 9

Accepted Solution

by:
mocarts earned 1000 total points
ID: 8244416
ok, here will be, but with one limitation - there must be a top item (i.e. item with PrevID=0)...
kretzschmar, in this case comparing for less or bigger is not acceptable as these are primary key values and PrevID can contain any ID..

uses contnrs;

type
  TItem = class
  private
    ID, PrevId: integer;
  public
    constructor Create(const ID, PrevID: integer);
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  lst: TObjectList;
  i, id, idx: integer;
begin
  lst := TObjectList.Create;
  try
  lst.Add(TItem.Create(1, 3));
  lst.Add(TItem.Create(2, 7));
  lst.Add(TItem.Create(3, 2));
  lst.Add(TItem.Create(4, 1));
  lst.Add(TItem.Create(8, 0));
  lst.Add(TItem.Create(7, 8));

  // find a top item..
  idx := -1;
  for i := 0 to lst.Count -1 do begin
    if TItem(lst[i]).PrevID = 0 then
    begin
      lst.Move(i, 0);
      idx := 0;
      break;
    end;
  end;
  if idx = -1 then
    raise Exception.Create('There is no top item!');
  while idx < lst.Count do begin
    id := TItem(lst[idx]).ID;
    for i := idx + 1 to lst.Count -1 do begin
      if TItem(lst[i]).PrevID = id then begin
        lst.Move(i, idx+1);
        break;
      end;
    end;
    inc(idx);
  end;
  for i := 0 to lst.Count -1 do
    with TItem(lst[i]) do
    Memo1.Lines.Add(inttostr(ID)+#9+inttostr(PrevID));
  finally
    lst.Free;
  end;
end;

{ TItem }

constructor TItem.Create(const ID, PrevID: integer);
begin
  inherited Create;
  Self.ID := ID;
  Self.PrevID := PrevID;
end;
end.
wbr, mo.
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 8244424
well, i see
(i got now headache myself :-))

the PrevID is referenced by ID from another record
-> typical hierarchic architectur
whereas 0 is perentless

is this correct?

if so,
then discard the solutions above

working . . .

meikl ;-)
0
 

Author Comment

by:Dev6
ID: 8244511
to meikl : yes, that's what i need

to mo : will check the code ....
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 8244580
well my version

procedure TForm1.Button4Click(Sender: TObject);
begin
  FTestList.Clear;
  FTestList.Add(TTest.Create(1, 3));
  FTestList.Add(TTest.Create(3, 2));
  FTestList.Add(TTest.Create(2, 7));
  FTestList.Add(TTest.Create(8, 0));
  FTestList.Add(TTest.Create(7, 8));
  FTestList.Add(TTest.Create(4, 1));
  PrintOut;
end;


//find the next
function TForm1.findNext(ForID : Integer) : integer;
var i : integer;
begin
  i := 0;
  while (i < FTestList.Count) and (TTest(FTestList[i]).PrevID <> ForID) do
    inc(I);
  if i = FTestList.Count then
    raise exception.Create('Something is wrong with the Data');
  result := i;
end;

procedure TForm1.sortHierarchical;
var
  List : TList;
  CurrentID, index : Integer;
  i : Integer;
begin
  List := TList.Create;
  try
    CurrentID := 0;
    //Read_Out
    while FtestList.Count > 0 do
    begin
      index := findNext(CurrentID);
      List.Add(pointer(CurrentID));
      CurrentID := TTest(FTestList[Index]).ID;
      if FtestList.Count = 1 then
        List.Add(pointer(CurrentID));  //do not miss the last
      FTestList.Delete(Index);
    end;
    //Fill in Sorted
    for i := 0 to List.Count - 2 do
      FTestList.Add(TTest.Create(integer(List[i+1]),integer(List[i])));
  finally
    List.Free;
  end;
end;


procedure TForm1.Button5Click(Sender: TObject);
begin
  SortHierarchical;
  PrintOut;
end;

meikl ;-)
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
In this video we outline the Physical Segments view of NetCrunch network monitor. By following this brief how-to video, you will be able to learn how NetCrunch visualizes your network, how granular is the information collected, as well as where to f…
In this video, Percona Solutions Engineer Barrett Chambers discusses some of the basic syntax differences between MySQL and MongoDB. To learn more check out our webinar on MongoDB administration for MySQL DBA: https://www.percona.com/resources/we…
Suggested Courses
Course of the Month13 days, 22 hours left to enroll

800 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question