Generic from the RTL for sorted list of objects

[dummzeuch 1505]

I'm still kind of new to using generics but I try to start using them where previously I would have created a pseudo template.

 

I need to store some objects and access them giving a string key. I thought that a TObjectDictionary<string, TMyClass> would be the solution for this, but it turns out that it does not allow duplicates, but I need that. Later on I want to get the first matching entry and enumerate all of them.

 

What would be the best generic container for allowing duplicates in this case, if there is any? Some kind of sorted object list?

 

(I'm asking for generics that are part of the RTL, please don't point me to any 3rd party implementations.)

[David Heffernan 2345]

I don't think there is any generic collection that meets your needs in the rtl. Perhaps you'll just have to give up. 

[aehimself 396]

You always can use a TObjectDictionary<String, TObjectList<TMyClass>>. That way you can have multiple instances of TMyClass assigned to the same string key.

[Tom Chamberlain 47]

It works better if you can break it down and use a key for the child objects also:

 

TChildList = TObjectDictionary<UniqueKey, TMyClass>;

MyList: TObjectDictionary<String, TChildList>;

 

UniqueKey is a priority/sequence number in our system for each unique child, we use an integer.  This makes searching and processing child objects simple.

var
 localChild: TMyclass;

if MyList.ContainsKey(SearchString) then
 for localChild in Mylist[SearchString].Values do
  begin

    localChild.....whatever

  end;

and

if MyList.ContainsKey(SearchString) then
 if MyList[SearchString].ContainsKey(UniqueKey) then
  begin
   localChild := MyList[SearchString].Items[UniqueKey];
   
   localChild...whatever
  
  end;

 

Edited January 25, 2023 by Tom Chamberlain

[dummzeuch 1505]

53 minutes ago, David Heffernan said:

I don't think there is any generic collection that meets your needs in the rtl. Perhaps you'll just have to give up. 

You're still miffed, apparently.

[programmerdelphi2k 237]

always and act for impulse! 😁

[Uwe Raabe 2057]

3 hours ago, aehimself said:

You always can use a TObjectDictionary<String, TObjectList<TMyClass>>.

That is exactly what I would have suggested. I have seen quite a couple of implementations using that pattern.

[programmerdelphi2k 237]

my test for TObject or any other type, you can create yourself class for easy access using another types

-- not copyed, not chatBOTs  >:)))

implementation

{$R *.dfm}

uses
  System.Generics.Collections;

type
  TMyObjList    = TObjectList<TObject>;
  TMyDicObjList = TDictionary<string, TMyObjList>;

var
  LDic: TMyDicObjList;

procedure MyShowingObjects(const ADic: TMyDicObjList; const LClearMemo: boolean = false);
var
  LText: string;
begin
  for var K in ADic do
    begin
      LText := LText + '...Key = ' + K.Key + ', Addr = ' + integer(K.Value).ToString + slinebreak;
      //
      for var V in TMyObjList(K.Value) do
        LText := LText + '......Value = ' + V.ToString + ', Addr = ' + integer(V).ToString + slinebreak;
    end;
  //
  if LClearMemo then
    Form1.Memo1.Text := LText
  else
    Form1.Memo1.Lines.Add(LText);
end;

procedure MyFreeObjectsFromList(const ADic: TMyDicObjList);
//var
//  LO: TMyObjList;   
begin
  while (LDic.Count > 0) do
    begin
      for var K in LDic.Keys do
        begin
          //if LDic.TryGetValue(K, LO) then  // I forgot that I use "True" param in "LDic.Add(LKey, TMyObjList.Create(true));"!!!
          //  begin
          //  for var V in LO do
              // LDic[K].Remove(V); // remove TObject
              //
          FreeAndNil(LDic[K]); // remove TObjectList
          //  end;
          //
          LDic.Remove(K); // remove Keys
        end;
    end;
end;

function MyFindObject(const ADic: TMyDicObjList; const AKey: string = ''; const AObjAddress: integer = 0): TObject;
begin
  result := nil;
  //
  if (ADic = nil) or (ADic.Count = 0) or (AObjAddress < 1) then
    exit;
  //
  if (AKey = '') then
    begin
      for var K in ADic.Keys do
        for var O in ADic[K] do
          if integer(O) = AObjAddress then
            exit(O);
    end
  else begin
      if ADic.ContainsKey(AKey) then
        for var O in ADic[AKey] do
          if integer(O) = AObjAddress then
            exit(O);
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  LDic := TMyDicObjList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyFreeObjectsFromList(LDic);
  //
  LDic.Free;
end;

procedure TForm1.BtnAddObjectListHelloClick(Sender: TObject);
var
  LKey: string;
begin
  LKey := BtnAddObjectListHello.Caption;
  //
  if not LDic.ContainsKey(LKey) then
    LDic.Add(LKey, TMyObjList.Create(true));
  //
  LDic[LKey].Add(TObject.Create);
  //
  MyShowingObjects(LDic, true);
end;

procedure TForm1.BtnAddObjectListWolrdClick(Sender: TObject);
var
  LKey: string;
begin
  LKey := BtnAddObjectListWolrd.Caption;
  //
  if not LDic.ContainsKey(LKey) then
    LDic.Add(LKey, TMyObjList.Create(true));
  //
  LDic[LKey].Add(TObject.Create);
  //
  MyShowingObjects(LDic, true);
end;

procedure TForm1.BtnGetObjectOnListClick(Sender: TObject);
var
  O: TObject;
begin
  O := MyFindObject(LDic, Trim(EdtKey.Text), StrToIntDef(EdtAddress.Text, -1)); // by address or any other from class!
  //
  if (O <> nil) then
    Memo1.Lines.Add('Obj found = ' + integer(O).ToString)
  else
    Memo1.Lines.Add('Obj = Not Found');
end;

procedure TForm1.BtnDeleteAllObjectsClick(Sender: TObject);
begin
  MyFreeObjectsFromList(LDic);
  //
  MyShowingObjects(LDic, true);
end;

initialization

ReportMemoryLeaksOnShutdown := true;

end.

Edited January 26, 2023 by programmerdelphi2k

[dummzeuch 1505]

Hm, shouldn't freeing the dictionary automatically free the object lists stored in it, which would then in turn free the objects stored in those? So there should be no need for the MyFreeObjectsFromList procedure, or am I overlooking something?

[aehimself 396]

Only if you create them like:

 

TObjectDictionary<T>.Create([doOwnsValues]);
TObjectList<T>.Create(True);

[dummzeuch 1505]

I'll try that dictionary + object list approach tomorrow. It's actually much neater than the sorted object list I was thinking about, and should also perform better, but that's not a real concern as I expect only a few dozen entries for the current need. But on the other hand, I'll probably start using this in a lot of other cases in the future.

[aehimself 396]

The only downside is, when adding a new key you'll have to do two commands:

 

_dictionary.Add(myKey, TObjectList<TMyClass>.Create);

_dictionary[myKey].Add(myObject);

 

The neat thing is, you can nest them down until infinity, if you have the stomach to bear it. I personally start to feel uncomfortable after 2 🙂

[programmerdelphi2k 237]

remember: you can use Arrays (a little complicated, but possible ) as your container instead TObjectList or TDictionary, of course, without many benefits, by other side, without many intrincics TList memory usage.

 

Arr := Arr + [ obj ]

dic = a litlle more complicated here ( a "record" can help you )

Edited January 25, 2023 by programmerdelphi2k

[Uwe Raabe 2057]

type
  TObjectDictionaryWithDuplicateObjects<K,V:class> = class(TObjectDictionary<K, TObjectList<V>>)
  public
    procedure AddObject(const Key: K; Value: V);
  end;

procedure TObjectDictionaryWithDuplicateObjects<K, V>.AddObject(const Key: K; Value: V);
var
  list: TObjectList<V>;
begin
  if not TryGetValue(Key, list) then
  begin
    list := TObjectList<V>.Create;
    Add(Key, list);
  end;
  list.Add(Value);
end;

 

[aehimself 396]

I have a hunch you can do the same if you override the protected Notify method somehow but yes, Uwe's solution will definitely work.

 

8 minutes ago, Uwe Raabe said:

    list := TObjectList<V>.Create;

 

Shouldn't this be TObjectList<V>.Create(True); ?

[Stefan Glienke 2002]

26 minutes ago, aehimself said:

Shouldn't this be TObjectList<V>.Create(True); ?

No, because the parameterless TObjectList<T> constructor sets OwnsObjects to True. And that is nothing new but also already was the case in the old TObjectList from Contnrs.pas

 

I am glad I can use Spring4D and have several flavors of multimaps at my disposal 

Edited January 25, 2023 by Stefan Glienke

[aehimself 396]

1 minute ago, Stefan Glienke said:

No, because the parameterless TObjectList constructor sets OwnsObjects to True

So for years now I added that parameter without any particular purpose...? 😮

Time to revisit my old codes, then.

 

Thank you for bringing this to my attention!

[dummzeuch 1505]

10 hours ago, Uwe Raabe said:

type
  TObjectDictionaryWithDuplicateObjects<K,V:class> = class(TObjectDictionary<K, TObjectList<V>>)
  public
    procedure AddObject(const Key: K; Value: V);
  end;

procedure TObjectDictionaryWithDuplicateObjects<K, V>.AddObject(const Key: K; Value: V);
var
  list: TObjectList<V>;
begin
  if not TryGetValue(Key, list) then
  begin
    list := TObjectList<V>.Create;
    Add(Key, list);
  end;
  list.Add(Value);
end;

 

Hm, you declared K and V as class. An oversight? Changing  this to TObjectDictionaryWithDuplicateObjects<K; V:class> (semicolon instead of comma) made it work (or rather compile) for me.

[Uwe Raabe 2057]

21 minutes ago, dummzeuch said:

Hm, you declared K and V as class. An oversight?

Indeed 

[dummzeuch 1505]

It not merely compiles but works as expected.

[David Heffernan 2345]

19 hours ago, Uwe Raabe said:

type
  TObjectDictionaryWithDuplicateObjects<K,V:class> = class(TObjectDictionary<K, TObjectList<V>>)
  public
    procedure AddObject(const Key: K; Value: V);
  end;

procedure TObjectDictionaryWithDuplicateObjects<K, V>.AddObject(const Key: K; Value: V);
var
  list: TObjectList<V>;
begin
  if not TryGetValue(Key, list) then
  begin
    list := TObjectList<V>.Create;
    Add(Key, list);
  end;
  list.Add(Value);
end;

 

Sad to see two lookups rather than one when the key is not in the dictionary. But that's the sort of thing that happens when your collection choice is limited. Given those constraints, I doubt this can be bettered. 

23 hours ago, dummzeuch said:

You're still miffed, apparently.

Confused actually. Your previous posts have rejected writing new code because it needs to be tested.