Jump to content
Sign in to follow this  
Mike Torrettinni

Array size increase with generics

Recommended Posts

Just wanted to share with you how I finally made SetLength work with Generics 🙂

 

Across all my projects, I use a lot of arrays, a lot! started with Array of, now slowly converting all to TArray and even slower started using TList for some cases.

So, in all my methods I use the common way to increase size of array - when adding records:

 

if vIndex > High(DataArray) then
  SetLength(DataArray, NewLength); 

 

This means I had this in all the methods... a lot of arrays = a lot of methods = a lot of SetLength calls.

 

So, then I started setting methods so I reduced 2 lines into 1 line, with:

 

procedure DataSize(var aDataArray: TArray<>; aIndex: integer);
begin
  if aIndex > High(aDataArray) then
  	SetLength(aDataArray, NewLength);
end;

 

and calling in all methods :

 

DataSize(DataArray, vIndex);

 

So, this was a progress. And I liked it a lot!

 

Then it progressed to having all DataSize procedures for all kinds of record types, overloaded. Even better!

 

And now I finally was able to take time and try with Generics, and this is what I have now:

 

 TArray = class(System.Generics.Collections.TArray)
  private
    class function NewSize(aCurrLength: integer): integer; // seperate function so I can manipulate how the New Length is calculated 
  public
    class procedure DataSize<T>(var aData: TArray<T>; aIndex: integer);
  end;

const cFactor = 1.2; // increase by 20%

class function TArray.NewSize(aCurrLength: integer): integer;
begin
  Result := Ceil(aCurrLength * cFactor);
end;
  
class procedure TArray.DataSize<T>(var aData: TArray<T>; aIndex: integer);
begin
  if aIndex > High(aData) then
    SetLength(aData, NewSize(Length(aData)));
end;

 

The call is a bit ugly, since you have to use TArray. I only used it a few times, so far, so I'm not complaining, yet:

 

TArray.DataSize<TRecLine>(Data, vIdx);

 

These Generics are pretty good! 😉

Share this post


Link to post
15 minutes ago, Attila Kovacs said:

I'd prefer Lines.Add(Data);

I always add data with assigning values directly:

SetLength(Data, StartLen); // prepare
vIdx := 0;

// add records to Data
for i := a to b do
begin
	TArray.DataSize<TRecLine>(Data, vIdx);

	Data[vIdx].Id  := ...;
	Data[vIdx].Str := ...;
	Inc(vIdx);
end;

SetLength(Data, vIdx); // finalize

 

Edited by Mike Torrettinni

Share this post


Link to post
56 minutes ago, David Heffernan said:

Ugh. Just use a generic list and scrap most of this duplicated code. 

I'd like to do that - but when creating Json with the TJson helpers, the TList<T> creates an unwanted effect.

TArray<T>: 

{"int":0,"list":[{"str":"A"},{"str":"B"},{"str":"C"}]}

TObjectList<T>:

{"int":0,"list":{"ownsObjects":true,"listHelper":[{"str":"A"},{"str":"B"},{"str":"C"}]}}
 

Ideally, I'd like to use TObjectList<T> - but have the Json look like what a TArray produces.

 

program TArrayVSTList;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  System.Classes,
  Generics.Defaults,
  Generics.Collections,
  Rest.Json;

type

  TObj = class(TObject)
  private
    FStr: String;
  public
    property Str: String read FStr write FStr;
    constructor Create(const s: String); virtual;
  end;

  TListTest<T:TObj> = class(TObject)
  type
    TCont = class(TObjectList<T>);
  private
    FInt: Integer;
    FList: TCont;
  public
    property Int: Integer read FInt write FInt;
    property List: TCont read FList write FList;
    procedure Add(const s: String);
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  TArrayTest<T:TObj> = class(TObject)
  type
    TContA = TArray<T>;
  private
    FInt: Integer;
    FList: TContA;
  public
    property Int: Integer read FInt write FInt;
    property List: TContA read FList write FList;
    procedure Add(const s: String);
    constructor Create; virtual;
    destructor Destroy; override;
  end;

{ TObj }

constructor TObj.Create(const s: string);
begin
  str := s;
end;

{ TListTest<T> }

procedure TListTest<T>.Add(const s: String);
begin
  FList.Add(TObj.Create(s));
end;

constructor TListTest<T>.Create;
begin
  FList := TCont.Create;
end;

destructor TListTest<T>.Destroy;
begin
  FList.Free;
  inherited;
end;

{ TArrayTest<T> }

procedure TArrayTest<T>.Add(const s: String);
begin
  var len := Length(FList);
  SetLength(FList, len + 1);
  FList[len] := T.Create(s);
end;

constructor TArrayTest<T>.Create;
begin
  // Nothing needs to happen here
end;

destructor TArrayTest<T>.Destroy;
begin
  for var Element:T in List
   do Element.Free;
  SetLength(FList, 0);
  inherited;
end;

procedure TestJson;
begin
  var Arr := TArrayTest<TObj>.Create;
  Arr.Add('A');
  Arr.Add('B');
  Arr.Add('C');
  Writeln(TJson.ObjectToJsonString(Arr,
    [joIgnoreEmptyStrings, joIgnoreEmptyArrays, joDateIsUTC, joDateFormatISO8601]));

  var List := TListTest<TObj>.Create;
  List.Add('A');
  List.Add('B');
  List.Add('C');
  Writeln(TJson.ObjectToJsonString(List,
    [joIgnoreEmptyStrings, joIgnoreEmptyArrays, joDateIsUTC, joDateFormatISO8601]));
end;

begin
  try
    try
      TestJson
    except
      on E: Exception do
        Writeln(E.ClassName, ': ', E.Message);
    end;
  finally
    Write('Press Enter: ');
    Readln;
  end;
end.

 

Share this post


Link to post
3 minutes ago, Lars Fosdal said:

I'd like to do that - but when creating Json with the TJson helpers, the TList<T> creates an unwanted effect.

Change the way you do JSON persistence then. Fix the real problem. 

Edited by David Heffernan

Share this post


Link to post
19 minutes ago, David Heffernan said:

Change the way you do JSON persistence then. Fix the real problem. 

Suggestions on how would be appreciated.  Apart from the generic list thing - this works so well.

Share this post


Link to post

@Uwe Raabe Both ways.  I implemented a generic JsonRPC server and client using this method of JSON serializing/deserializing.  
The protocol endpoint handler code does not see the raw JSON all, only objects.

Share this post


Link to post

I use this

  // ***************************************************************************
  // Static class that helps perform some actions over dynamic arrays
  // ***************************************************************************

  TArrHelper<T> = class
  public
    class procedure Delete(var Arr: TArray<T>; Index: Integer);
    class procedure Insert(var Arr: TArray<T>; Index: Integer; const Item: T);
    class procedure Grow(var Arr: TArray<T>); inline;
    class procedure Trunc(var Arr: TArray<T>); inline;
    class procedure Add(var Arr: TArray<T>; const Item: T); overload; inline;
    class procedure Add(var Arr: TArray<T>; const ArrToAdd: TArray<T>); overload;
    class function Add(var Arr: TArray<T>): Ptr<T>.P; overload;
    class function First(const Arr: TArray<T>): T; inline;
    class function FirstPtr(const Arr: TArray<T>): Ptr<T>.P; inline;
    class function Last(const Arr: TArray<T>): T; inline;
    class function LastPtr(const Arr: TArray<T>): Ptr<T>.P; inline;
  end;

TArrHelper<string>.Add(StrArr, 'foo')

  • Like 2

Share this post


Link to post
2 hours ago, Lars Fosdal said:

Suggestions on how would be appreciated.  Apart from the generic list thing - this works so well.

I use YAML rather than JSON, with my own wrapper of libyaml. And I have written my own library to handle persistence, not RTTI based. I think you are always going to suffer if you let the standard JSON library try to do persistence for you based on RTTI.

  • Like 1

Share this post


Link to post

For me, using JSON is a must.  The same single JsonRPC server serves Google Glass Java applets, Python clients in VoCollect A500 hip computers, Delphi FireMonkey touch applications under Windows 10, and various APIs to PLCs and third-party autonomous robots from Toshiba, Elettric80 and others. 

If I can find a viable alternative that allows me to replace the TArray<T>'s with TObjectList<T>, I'll be happy to have a look at it for robustness and speed, but the current solution handles a very large number of transactions daily, and the serializing and deserializing is not something that raises issues.

Share this post


Link to post
1 hour ago, Lars Fosdal said:

If I can find a viable alternative that allows me to replace the TArray<T>'s with TObjectList<T>, I'll be happy to have a look at it

Not sure if this works for you, but at least it works for me with 10.3.3.

 

Let's start with a TJSONInterceptor descendant for a generic TObjectList<T>. Note that <T> represents the type of a list item, not the type of the list itself.

type
  TObjectListInterceptor<T: class> = class(TJSONInterceptor)
  public
    procedure AfterConstruction; override;
    function TypeObjectsConverter(Data: TObject): TListOfObjects; override;
    function TypeObjectsReverter(Data: TListOfObjects): TObject; override;
  end;

procedure TObjectListInterceptor<T>.AfterConstruction;
begin
  inherited;
  ObjectType := T;
end;

function TObjectListInterceptor<T>.TypeObjectsConverter(Data: TObject): TListOfObjects;
var
  list: TObjectList<T>;
  I: Integer;
begin
  list := TObjectList<T>(Data);
  SetLength(Result, list.Count);
  for I := 0 to list.Count - 1 do
    Result[I] := list[I];
end;

function TObjectListInterceptor<T>.TypeObjectsReverter(Data: TListOfObjects): TObject;
var
  list: TObjectList<T>;
  obj: TObject;
begin
  list := TObjectList<T>.Create;
  for obj in Data do
    list.Add(T(obj));
  Result := list;
end;

Now lets assume you have a list of TMyObject classes. So you need to declare these two aliases:

type
  TMyObjectList = TObjectList<TMyObject>; { this one is actually not needed, just for readability }
  TMyObjectListInterceptor = TObjectListInterceptor<TMyObject>;

Now we can declare a container class with a field of type TMyObjectList:

type
  TMyClass = class
  private
    [JsonReflect(ctTypeObjects, rtTypeObjects, TMyObjectListInterceptor)]
    FContent: TMyObjectList; { this could as well be TObjectList<TMyObject> }
    FCount: Integer;
    FPage: Integer;
    FPageCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
  end;

constructor TMyClass.Create;
begin
  inherited Create;
  FContent := TMyObjectList.Create();
end;

destructor TMyClass.Destroy;
begin
  FContent.Free;
  inherited Destroy;
end;
      

 

Edited by Uwe Raabe
  • Like 1
  • Thanks 1

Share this post


Link to post
4 hours ago, Lars Fosdal said:

For me, using JSON is a must

I wasn't suggesting otherwise. I was just saying that my experience is with YAML, but the issues are essentially the same. You can't expect any system to be able to serialise arbitrary classes without some input from the coder. 

Share this post


Link to post

There is input in the shape of attributes.
I was just disappointed that they didn't go the whole nine yards with TObjectList<T> support in addition to TArray<T>.

Share this post


Link to post
57 minutes ago, Lars Fosdal said:

There is input in the shape of attributes.

I even found a simpler solution and am going to publish a blog post about that soon.

  • Like 1
  • Thanks 1

Share this post


Link to post

Nice, Uwe! I missed your reply from Friday! Going to test it out.

Is it possible to inject this at the root of a class hierarchy, or is it necessary to inject the attribute per objectlist reference in the descending classes?

Share this post


Link to post
2 minutes ago, Lars Fosdal said:

Is it possible to inject this at the root of a class hierarchy, or is it necessary to inject the attribute per objectlist reference in the descending classes?

The shown approach has some drawbacks, one being that it only works with aliases of TObjectList<T>, not for derived classes. While this was no problem in the my case, it bugged me a bit as I see classes derived from TObjectList<T> probably as a not so uncommon use case.

 

Unfortunately the current implementation is a bit resistent against extensions, f.i. because methods are not virtual or instances are created directly instead of using some factory approach. Thus the possible solutions are a bit limited and not as developer friendly as expected. On the other hand, this may change in the future and if we can get an TObjectList<T> approach working now, it probably can be made more friendly in the future.

  • Like 1

Share this post


Link to post

"Note that we need at least one type keyword between the alias and its use inside the attribute."

 

                   As If Millions Of Voices Suddenly Cried Out

image.png.92d4059945eaf2fa50ebdd5dc914e1bb.png

 

 

Didn't know this 😮

Then this "type"-ing could also impact compile speed in some units.

 

 

Unfortunately this will barely work for example in Berlin U2 (or prior) as it was released meanwhile a 

coffee break and my "REST.JsonReflect.pas" has things like

 

raise Exception.Create('NOT IMPLEMENTED');

or

"revAttr.ObjectsReverter(Data, FieldName, GetArgObjects(revEv.FFieldClassType,"

where revEv is not setted in the 3rd case of the if, and it's either nil or points to garbage.

 

 

I gave up pursuing TObjectList and JSON.

A single "virtual;" on any random method of any random JSON handler class would make it 1000% more usable.

I ended up with a base class where I'm managing the objects through RTTI, and storing them in arrays.

Drawback is, every object must inherit from this base class or handle its objects himself.

 

I don't like it either.

 

 

Edited by Attila Kovacs

Share this post


Link to post
Quote

Note that we need at least one type keyword between the alias and its use inside the attribute.

This is really confusing. So the new "type" section makes compiler consider class completely defined :classic_blink:

What is an explanation of this?

type
  TMyObjectList = TObjectList<TMyObject>;
  TMyObjectListInterceptor = TObjectListInterceptor<TMyObject>;
type
// if above "type" keyword is commented out then
// [dcc32 Error]: E2086 Type 'TObjectListInterceptor<T>' is not yet completely defined
  TMyClass = class
  private
    [JsonReflect(ctTypeObjects, rtTypeObjects, TMyObjectListInterceptor)]
    FContent: TMyObjectList;
  end;

 

Edited by Dmitriy M

Share this post


Link to post
1 hour ago, Attila Kovacs said:

Unfortunately this will barely work for example in Berlin U2 (or prior)

Currently this will only work in Delphi 10.3.3 Rio thanks to implementing a code change I suggested in QP together with a couple of failing test cases (unfortunately only people with access to that beta are able to see it).

 

26 minutes ago, Dmitriy M said:

This is really confusing. So the new "type" section makes compiler consider class completely defined :classic_blink:

What is an explanation of this?

I just have none, but after all I am not the Delphi compiler engineer.

  • Like 1

Share this post


Link to post
1 hour ago, Attila Kovacs said:

Unfortunately this will barely work for example in Berlin U2 (or prior) as it was released meanwhile a 

coffee break and my "REST.JsonReflect.pas" has things like

 

raise Exception.Create('NOT IMPLEMENTED');

or

"revAttr.ObjectsReverter(Data, FieldName, GetArgObjects(revEv.FFieldClassType,"

where revEv is not setted in the 3rd case of the if, and it's either nil or points to garbage.

It's not that difficult to modify REST.JsonReflect.pas to make it work in 10.2 (maybe prior versions too)

procedure TJSONUnMarshal.PopulateFields
{...}
          case revAttr.ReverterType of
            rtTypeObjects:
              begin
                Delete(FieldName, 1, 1);
                if (jsonFieldVal is TJSONArray) or (jsonFieldVal is TJSONNull) then
                begin
//                  raise Exception.Create('NOT IMPLEMENTED');
                  SetField(Data, FieldName, revAttr.TypeObjectsReverter(GetArgObjects(LObjectType,
                    TJSONArray(jsonFieldVal))))
                end
                else
                  raise EConversionError.Create(Format(SArrayExpectedForField, [FieldName, jsonFieldVal.ToString]));
              end;
            rtTypeStrings:
{...}
function JsonReflectAttribute.JSONInterceptor: TJSONInterceptor;
begin
//  Result := FInterceptor.NewInstance as TJSONInterceptor;;
  Result := FInterceptor.Create as TJSONInterceptor;
  Result.ConverterType := FConverterType;
  Result.ReverterType := FReverterType;
end;

This works like a charm with @Uwe Raabe code from this post.

Edited by Dmitriy M

Share this post


Link to post

@Dmitriy M Yes, but if I would touch the RTL I would rather make some of the methods virtual and get is solved without any attribute decoration if possible.

Or adding an OnCreateObject event for the case it's not able to create the object from the RTTI information (which I'm still not getting why isn't it able to do so).

Maybe I should make these changes and present a working version instead of speculating. I wish I had time for that (too).

Share this post


Link to post

I wish there was a way to have the Json engine recognize the T in TObjectList<T> from the RTTI.  That would have saved us a ton of scaffolding code.

 

 

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
Sign in to follow this  

×