Jump to content
dummzeuch

Generic from the RTL for sorted list of objects

Recommended Posts

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.)

Share this post


Link to post

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

  • Like 2
  • Thanks 1

Share this post


Link to post

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 by Tom Chamberlain
  • Thanks 1

Share this post


Link to post
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.

  • Haha 1

Share this post


Link to post
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.

Share this post


Link to post

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.

image.thumb.png.32191f40a01ff550f370d912cc084a29.png

Edited by programmerdelphi2k
  • Thanks 1

Share this post


Link to post

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?

Share this post


Link to post

Only if you create them like:

 

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

  • Thanks 1

Share this post


Link to post

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.

Share this post


Link to post

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 🙂

Share this post


Link to post

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 by programmerdelphi2k

Share this post


Link to post
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;

 

  • Like 2
  • Thanks 1

Share this post


Link to post

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); ?

Share this post


Link to post
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 :classic_cool:

Edited by Stefan Glienke
  • Like 5

Share this post


Link to post
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!

Share this post


Link to post
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.

Share this post


Link to post
21 minutes ago, dummzeuch said:

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

Indeed :classic_blush:

Share this post


Link to post
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. 

Share this post


Link to post

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×