Sorting TStringlist and retaining original index

Question

I have a Question about Delphi StringLists and sorting them. I am sorting a list of attributes (with duplicate entries) so I need to retain their original index before the sort. Here is a sample of what I am trying

procedure TestFind;
var
  i, iIndex :integer;
  slStrings : TStringlist;
begin
    slStrings := TStringList.Create;   
    slStrings.Sorted := False;

    slStrings.Add('Zebra');
    slStrings.AddObject('Zebra',TObject(1));   
    slStrings.Add('Bat');
    slStrings.AddObject('Bat',TObject(2));
    slStrings.Add('Cat');
    slStrings.AddObject('Cat',TObject(3));
    slStrings.Add('Hat');
    slStrings.AddObject('Hat',TObject(4));
    slStrings.Add('Aat');
    slStrings.AddObject('Aat',TObject(5));      

    slStrings.sorted := True;   

    if slStrings.Find('Zebra',iIndex) then
    begin  
      while slStrings.Strings[iIndex] = slStrings.Strings[iIndex + 1] do
      begin
        i := ObjectToInt(slStrings.Objects[iIndex]) ;     
        AddMemoData ('Stringlist Found at Position: ' + inttoStr(i) + ' Current index position is: ' + inttoStr(iIndex), false); 
        inc(iIndex);
      end;    

      i := ObjectToInt(slStrings.Objects[iIndex]) ;     
      AddMemoData ('Stringlist Found at Position: ' + inttoStr(i) + ' Current index position is: ' + inttoStr(iIndex), false); 

    end;

end;

When I run this I get a Value of 0,8 for Zebra, this makes no sense to me, I would expect a message of 1,4

Answer 1

I really can't work out what your code is trying to achieve, but it is accessing beyond the end of the list. To avoid that your while test can be modified like so:

while (iIndex<slStrings.Count-1) 
  and (slStrings.Strings[iIndex] = slStrings.Strings[iIndex + 1]) do

Your use of Objects[] will work. Values placed there are kept with their matching Strings[] values when the list is sorted.

However, if I were you I would not use a string list for this task. I would declare a record like this:

TMyRec = record
  Name: string;
  Index: Integer;
end;

I would hold them in a TList<TMyRec> and then sort them using a custom comparer.

I note that you add each object twice, once with an associated index, and once without. Those latter instances will get a default index value of 0 . I also observe that the code you present will not execute because of the out of bounds error that I identified. Further, even when you fix that it does not give output of the form that you claim.

In other words, it appears that the code you posted is very different from the code that you are running. I've answered based on the code that you included in the question. I hope that you can accept an answer on that basis and don't expect help with the code that you have, that we cannot see. Perhaps I should just have voted to close.

Anyway, perhaps the main problem is here:

slStrings.Add('Zebra');
slStrings.AddObject('Zebra',TObject(1));   
slStrings.Add('Bat');
slStrings.AddObject('Bat',TObject(2));
slStrings.Add('Cat');
slStrings.AddObject('Cat',TObject(3));
slStrings.Add('Hat');
slStrings.AddObject('Hat',TObject(4));
slStrings.Add('Aat');
slStrings.AddObject('Aat',TObject(5));      

This is equivalent to:

slStrings.AddObject('Zebra',TObject(0));   
slStrings.AddObject('Zebra',TObject(1));   
slStrings.AddObject('Bat',TObject(0));
slStrings.AddObject('Bat',TObject(2));
slStrings.AddObject('Cat',TObject(0));
slStrings.AddObject('Cat',TObject(3));
slStrings.AddObject('Hat',TObject(0));
slStrings.AddObject('Hat',TObject(4));
slStrings.AddObject('Aat',TObject(0));      
slStrings.AddObject('Aat',TObject(5));      

Did you actually mean to write this:

slStrings.AddObject('Zebra',TObject(1));   
slStrings.AddObject('Bat',TObject(2));
slStrings.AddObject('Cat',TObject(3));
slStrings.AddObject('Hat',TObject(4));
slStrings.AddObject('Aat',TObject(5));      

Answer 2

the Solution was this:

procedure TestFind;
    var
    i, iIndex, iStringSize :integer;
    slStrings : TStringlist;
    begin
        slStrings := TStringList.Create;   
        slStrings.Sorted := False;

        slStrings.AddObject('Zebra',TObject(1));   
        slStrings.AddObject('Bat',TObject(2));
        slStrings.AddObject('Cat',TObject(3));
        slStrings.AddObject('Hat',TObject(4));
        slStrings.AddObject('Zebra',TObject(6));
        slStrings.AddObject('Aat',TObject(5)); 
        slStrings.AddObject('Zebra',TObject(7));     

        slStrings.sorted := True;   


        if slStrings.Find('Bat',iIndex) then
        begin  
          //find lowest position of string matching found string 
          while iIndex > 0 do
           begin
             if (g_slVials.Strings[iIndex] = g_slVials.Strings[iIndex-1]) then
               iIndex := iIndex - 1 
             else 
               break; 
           end;

          iStringSize := slStrings.Count;
          while iIndex < iStringSize -1 do  //check for more matching strings in higher range
          begin
            if (g_slVials.Strings[iIndex] = g_slVials.Strings[iIndex+1]) then  
            begin
              i := ObjectToInt(slStrings.Objects[iIndex]) ;     
              AddMemoData ('Stringlist Found at Position: ' + inttoStr(i) + ' Current index position is: ' + inttoStr(iIndex), false); 
              inc(iIndex);   
            end else
              break;
          end;    

          i := ObjectToInt(slStrings.Objects[iIndex]) ;     
          AddMemoData ('Stringlist Found at Position: ' + inttoStr(i) + ' Current index position is: ' + inttoStr(iIndex), false); 

        end;

    end;

this allows me to find all matching strings and return their index position