How can I remove empty elements or elements with nil pointers from an Array? A generic solution would be welcome.
You could write it like this:
type
TArrayHelper = class
class function RemoveAll<T>(var Values: TArray<T>; const Value: T); static;
end;
....
function TArrayHelper.RemoveAll<T>(var Values: TArray<T>; const Value: T);
var
Index, Count: Integer;
DefaultComparer: IEqualityComparer<T>;
begin
// obtain an equality comparer for our type T
DefaultComparer := TEqualityComparer<T>.Default;
// loop over the the array, only retaining non-matching values
Count := 0;
for Index := 0 to high(Values) do begin
if not DefaultComparer.Equals(Values[Index], Value) then begin
Values[Count] := Values[Index];
inc(Count);
end;
end;
// re-size the array
SetLength(Values, Count);
end;
Suppose that you had an array of pointers:
var
arr: TArray<Pointer>;
Then you would remove the nil elements like this:
TArrayHelper.RemoveAll<Pointer>(arr, nil);
This code takes the easy way out and always uses the default comparer. For more complex types that is no good. For instance some records need custom comparers. You would need to supply a comparer to support that.
The above implementation is as simple as possible. In terms of performance, it may well be wasteful in the likely common scenario where no matching values, or very few, are found. That's because the version above unconditionally assigns, even if the two indices are the same.
Instead, if there was an issue with performance, you might optimize the code by stepping through the array as far as the first match. And only then start moving values.
function TArrayHelper.RemoveAll<T>(var Values: TArray<T>; const Value: T);
var
Index, Count: Integer;
DefaultComparer: IEqualityComparer<T>;
begin
// obtain an equality comparer for our type T
DefaultComparer := TEqualityComparer<T>.Default;
// step through the array until we find a match, or reach the end
Count := 0;
while (Count<=high(Values))
and not DefaultComparer.Equals(Values[Count], Value) do begin
inc(Count);
end;
// Count is either the index of the first match or one off the end
// loop over the rest of the array copying non-matching values to the next slot
for Index := Count to high(Values) do begin
if not DefaultComparer.Equals(Values[Index], Value) then begin
Values[Count] := Values[Index];
inc(Count);
end;
end;
// re-size the array
SetLength(Values, Count);
end;
As you can see this is a lot more difficult to analyse. You would only contemplate doing this if the original version was a bottleneck.
Related
I've attempted to implement a merge sort for strings however I cannot perform the recursive part and I get the error "Invalid Pointer Operation"
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
var i : Integer;
const MyArray : array[1..5]of string = ('hi', 'zebra', 'apple', 'Xylophone', 'dog');
Procedure merge(result, left, right : array of string);
var i, i1, i2 : Integer;
begin
i1 := 0;
i2 := 0;
for i := 0 to Length(result) do
begin
if (i2 >= Length(right)) or (i1 < Length(left)) and (StrComp(PChar(left[i]), PChar(right[i2])) < 0) then
begin
result[i] := left[i1];
inc(i1);
end
else
begin
result[i] := right[i2];
inc(i2);
end;
end;
end;
Procedure mergeSort(OriginalList : array of string);
var left, right : array of string;
i : Integer;
begin
if (Length(OriginalList) >= 2) then
begin
setlength(left, length(OriginalList) div 2);
setlength(right, length(OriginalList) - (length(OriginalList) div 2));
for i := 0 to Length(left) do
begin
left[i] := OriginalList[i];
end;
for i := 0 to Length(right) do
begin
right[i] := OriginalList[i + Length(OriginalList) div 2];
end;
mergeSort(left);
mergeSort(right);
merge(OriginalList, left, right);
end;
end;
begin
writeln('The data before sorting: ');
for i := low(MyArray) to High(MyArray) do
begin
write(MyArray[i]+' ');
end;
writeln;
mergeSort(MyArray);
writeln('The data before sorting: ');
for i := low(MyArray) to High(MyArray) do
begin
write(MyArray[i]+' ');
end;
readln;
end.
On the line in the mereSort function where I recall the merge sort function on the arrays "left" and "right", I get the error message but I don't quite understand why?
There are many different things wrong with this, hopefully these points will help you in the right direction.
Problems with Array Indexes
You are indexing beyond the end of your arrays:
Dynamic arrays are indexed starting from zero so the line
for i := 0 to Length(left) do
should be
for i := 0 to Length(left) - 1 do
or you can use
for i := Low(left) to High(left) do
As you did later.
I would recommend you choose a standard form and use it consistently, and also that you avoid declaring constant arrays with non-zero based indexing unless you have good reason, this way you can use the same forms consistently or change the type of array later without running into trouble
This first fix will stop your program crashing, but you'll notice your sort code isn't changing anything...
Problems with parameter passing
Delphi has several different ways to pass parameters into procedures:
procedure doSomething(a : array of string);
procedure doSomething(var a : array of string);
procedure doSomething(out a : array of string);
procedure doSomething(const a : array of string);
These determine how what happens inside the procedure can affect the original variable passed
This is something you will need to understand, read up in the documentation:
http://docwiki.embarcadero.com/RADStudio/Tokyo/en/Parameters_(Delphi)
There is IMO some very confusing behaviour and syntax relating to array parameters and a lot of stuff that seems intuitive is not allowed especially with XE/older version, its worth reading the documentation about the standard data types
In the current state, your merge procedure will have no effect because it only operates on a new copy of the array you pass in, which you have also declared as constant
Other
I would avoid the use of result as a procedure parameter since this is the name used for function return values, it seems like asking for trouble to use it like that.
PS: I haven't looked at the logic of the merging, just the basic language mistakes
In pascal, the only way I dared cleaning my array was to simply iterate through it and clear it, but it is extremely inefficient. Can't I simply reinitialize it by assigning an empty array to it?
program arrays;
var
working, empty : array [1..10] of integer;
begin
working[3] := 5;
working:= empty;
end.
Is is ok to do this, can this backfire?
If you want to clear the array, writing:
working:= empty;
will in fact do the clearing, by copying the empty array content into working... in your case empty is void, since it is a global variable, so initialized with 0.
IMHO it is not a good practice to define such global variables. Global variables are evil in most cases (unless you know what you are doing), and in case of declaring them to be initialized with 0 does not make sense.
In fact, if empty is initialized on the stack (i.e. a var within a method), it is filled with whatever is on the stack at this time, i.e. some random data.
If you want to fast initialize an array which does not contain any reference counted types (like string), you can write:
fillchar(working,sizeof(working),0);
And if your array contains managed types, you can write:
finalize(workingWithStringInside); // to safely release internal managed types
fillchar(workingWithStringInside,sizeof(workingWithStringInside),0);
This is the faster code possible (faster than a variable copy), and sounds a better option.
This is absolutely fine. The semantics of the code are exactly what you need. Certainly the Delphi compiler will emit code to perform a simple and efficient memory copy. The compiler is able to do that because you have a fixed length array whose elements are simple value types. I'd be surprised if FPC did not produce very similar code.
Even if your array contained managed types (it doesn't), the assignment operator would result in code that respected those managed types.
As a final comment, the array full of zeros should be a constant.
An easy way is not to set your length of the variable in the type...and use SetLength to initialize the array for you... from Delphi help: When S is a dynamic array of types that must be initialized, newly allocated space is set to 0 or nil.
type
TIntArray = Array of Integer;
procedure WorkArrays(var aWorking: array of integer);
begin
if High(aWorking) >= 0 then
aWorking[0] := 1;
if High(aWorking) >= 3 then
aWorking[3] := 5;
end;
procedure WorkArrays2(var aWorking: array of integer);
begin
if High(aWorking) >= 1 then
aWorking[1] := 4;
if High(aWorking) >= 9 then
aWorking[9] := 7;
end;
procedure WorkArrays3(var aWorking: TIntArray);
begin
SetLength(aWorking, 0);
SetLength(aWorking, 4);
aWorking[0] := 1;
aWorking[3] := 5;
end;
procedure WorkArrays4(var aWorking: TIntArray);
begin
SetLength(aWorking, 0);
SetLength(aWorking, 10);
aWorking[1] := 4;
aWorking[9] := 7;
end;
procedure TForm58.ShowArrays(aWorking: array of integer);
var
a_Index: integer;
begin
for a_Index := Low(aWorking) to High(aWorking) do
Memo1.Lines.Add(IntToStr(aWorking[a_Index]));
end;
procedure TForm58.ShowArrays2(aWorking: TIntArray);
var
a_Index: integer;
begin
for a_Index := Low(aWorking) to High(aWorking) do
Memo1.Lines.Add(IntToStr(aWorking[a_Index]));
end;
procedure TForm58.Button1Click(Sender: TObject);
var
a_MyArray: array of integer;
a_MyArray1: TIntArray;
begin
//SetLength(aWorking, 0);
SetLength(a_MyArray, 3);//note this is a Zero based Array...0 to 2
WorkArrays(a_MyArray);//note aWorking[3] will not show...because High is 2...
ShowArrays(a_MyArray);
SetLength(aWorking, 0);
SetLength(a_MyArray, 10);//note this is a Zero based Array...0 to 9
WorkArrays2(a_MyArray);
ShowArrays(a_MyArray);
WorkArrays3(a_MyArray1);
ShowArrays2(a_MyArray1);
WorkArrays4(a_MyArray1);
ShowArrays2(a_MyArray1);
end;
I am creating an application which uses the AMB MyLaps decoder P3 Protocols.
I can't get my head around a way to sort the racers out based on laps and lap times. For example, the person in 1st has done 3 laps, the person in 2nd has done 2 laps. But then how do I order a situation where 2 people are on the same lap?
This is the record I'm using to hold the information:
type
TTimingRecord = record
position: integer;
transId: integer;
racerName: string;
kartNumber: integer;
lastPassingN: integer;
laps: integer;
lastRTCTime: TDateTime;
bestTimeMs: Extended;
lastTimeMs: Extended;
gapTimeMs: Extended;
splitTimeMs: Extended;
timestamp: TDateTime;
end;
A new record is created for each racer.
The code I'm currently using is:
procedure sortRacers();
var
Pos, Pos2: Integer;
Temp: TTimingRecord;
GapTime: Extended;
begin
for Pos := 0 to length(DriversRecord)-1 do
begin
for Pos2 := 0 to Length(DriversRecord)-2 do
begin
if(DriversRecord[Pos2].laps < DriversRecord[Pos2+1].laps)then
begin
Temp := DriversRecord[Pos2];
DriversRecord[Pos2] := DriversRecord[Pos2+1];
DriversRecord[Pos2+1] := Temp;
end
else if DriversRecord[Pos2].laps = DriversRecord[Pos2+1].laps then
begin
if DriversRecord[Pos2].lastRTCTime > DriversRecord[Pos2+1].lastRTCTime then
begin
Temp := DriversRecord[Pos2];
DriversRecord[Pos2] := DriversRecord[Pos2+1];
DriversRecord[Pos2+1] := Temp;
end;
end;
end;
end;
for pos := 1 to length(DriversRecord) -1 do //Gap Time
begin
if DriversRecord[Pos].laps = DriversRecord[0].laps then
begin
DriversRecord[Pos].gapTimeMs := DriversRecord[Pos].lastRTCTime - DriversRecord[0].lastRTCTime;
DriversRecord[Pos].splitTimeMs := DriversRecord[Pos].lastRTCTime - DriversRecord[Pos-1].lastRTCTime;
end;
end;
end;
But doesn't work too well :)
I'm assuming from your comment to the question, that you have decomposed the problem into sorting and comparing, and that you have got the sorting part covered. Which leaves order comparison.
You need a function that will perform a lexicographic order comparison based first on the number of laps completed, and secondly on the time since the start of this lap. Basically it will look like this:
function CompareRacers(const Left, Right: TTimingRecord): Integer;
begin
Result := CompareValue(Left.laps, Right.laps);
if Result=0 then
Result := CompareDateTime(Left.lastRTCTime, Right.lastRTCTime);
end;
You'll find CompareValue in Math and CompareDateTime in DateUtils.
What I'm not sure about is what the sense of the lastRTCTime values is. You may need to negate the result of the call to CompareDateTime to get the result you desire.
Result := -CompareDateTime(Left.lastRTCTime, Right.lastRTCTime);
Also, what happens if there is overtaking during the lap? Presumably you won't be able to detect that until the racers complete the current lap.
Instead of doing the sort algorithm yourself, try this technique (if you have a Delphi version compatible) : Best way to sort an array
And your function could look like this :
uses Types;
function CustomSort(const Left, Right: TTimingRecord): Integer
begin
If (left.laps > right.laps) then
result := GreaterThanValue
else
if (left.laps < right.laps) then
result := LessThanValue
else
begin
// Same laps count... Test on LastRTCTime
if (left.lastRTCTime < right.lastRTCTime) then
result := GreaterThanValue1
else
if (left.lastRTCTime > right.lastRTCTime) then
result := LessThanValue
else
result := EqualsValue;
end;
end));
It might be easier to look at this as 2 separate sorts.
Obviously you know the bubble-sort method, so I will not go into that.
Make 2 passes on your sorting.
1st, you sort the laps.
2nd, you run through the entire list of sorted laps. find begin point and end point in array for identical lap-values. Do the sorting again from begin and end points, but this time compare only the secondary value. iterate through all identical secondary values if the count of identical values are larger than 1.
This code is about sorting data using an Index. Way faster than bubble-sort.
It is dynamic and provides for ability to sort from a start-point to an end-point in an array.
The code itself is bigger than Bubble-Sort, but not many algorithms can compare on speed.
The code (when understanding how it works) can easily be modified to suit most kinds of sorting. On an array of 65536 strings, it only need to do 17 compares (or there about)
Some more CPU Cycles per compare cycle compared with Bubble Sort, but still among the fastest methods.
To search is equally as fast as BTREE. The actual sorting is perhaps slower, but the data is easier manageable afterwards with no real need for balancing the tree.
Enjoy.
Note: The routine is not the full solution to the actual problem, but it provides the beginning of an extreemely fast approach.
TYPE
DynamicIntegerArray = ARRAY OF INTEGER;
DynamicStringArray = ARRAY OF STRING;
VAR
BinSortLo, BinSortMid, BinSortHi : INTEGER;
FUNCTION FindMid:INTEGER;
BEGIN
FindMid:=BinSortLo+((BinSortHi-BinSortLo) DIV 2);
END;
PROCEDURE ShiftIndexUpAndStorePointer(VAR ArrParamIndex: DynamicIntegerArray; HighBound:INTEGER);
VAR
x : INTEGER;
BEGIN
FOR x:=HighBound-1 DOWNTO BinSortMid DO ArrParamIndex[x+1] := ArrParamIndex[x];// Shift the index.
ArrParamIndex[BinSortMid]:=HighBound;// Store the pointer to index at its sorted place
END;
PROCEDURE BinarySortUp(CONST ArrParam:DynamicStringArray; VAR ArrParamIndex: DynamicIntegerArray; CONST LoBound,HighBound:INTEGER); OVERLOAD;
VAR
TempVar : STRING;
BEGIN
BinSortLo:=LoBound; BinSortHi:=HighBound; BinSortMid:=FindMid;
TempVar := ArrParam[HighBound];
REPEAT
IF TempVar>ArrParam[ArrParamIndex[BinSortMid]] THEN BinSortLo:=BinSortMid ELSE BinSortHi:=BinSortMid;
BinSortMid:=FindMid;
UNTIL (BinSortMid=BinSortLo); {OR (BinSortMid=BinSortHi);}
IF TempVar>ArrParam[ArrParamIndex[BinSortMid]] THEN INC(BinSortMid);// We always need a last check just in case.
ShiftIndexUpAndStorePointer(ArrParamIndex,HighBound);
END;
PROCEDURE DynamicCreateIndex(CONST ArrParam:DynamicStringArray; VAR ArrParamIndex: DynamicIntegerArray; CONST LoBound,HighBound:INTEGER);
VAR
x : INTEGER;
BEGIN
FOR x:=LoBound TO HighBound DO
BinarySortUp(ArrParam,ArrParamIndex,LoBound,x);
END;
BEGIN
{
1. Create your STRING ARRAY as a DynamicStringArray.
2. Create your INDEX ARRAY as a DynamicIntegerArray.
3. Set the size of these arrays to any INTEGER size and fill the strings with data.
4. Run a call to DynamicCreateIndex(YourStringArray,YourIndexArray,0,SizeOfArray
Now you have a sorted Index of all the strings.
}
END.
I use TList/TObjectList and TStringList (with associated objects) for a multitude of tasks, either as-is, or as basis for more complex structures. While the sort functionality is usually good enough, I sometimes need to do a stable sort, and both lists use quicksort.
What's the easiest way to implement stable sorting for TList and/or TStringList? Do I have to write my own sorting routine, or can it be done by using some clever trick with TStringListSortCompare/TListSortCompare?
You'll have to write your own sorting routine.
You can read the current QuickSort implementation, and write your own stable version (e.g. a Merge sort or any other stable variant).
Some tricks:
If you are sure that an index is < Count, you can use the fast pointer array (TList.List[]) instead of slower Items[] or GetItem(): sub-method calling and range checking slow down the execution;
The comparison function is most of the time the speed bottleneck of the search - so take care of this part;
If you need speed, use a real profiler over real (e.g. random) data - but make it right before making it fast;
Start from an existing implementation of the sort;
To minimize stack space, you may use a temporary record to store and share variables among recursive calls.
This question is rather old, but here goes my answer for future readers:
I also needed this recently and adapted the implementation found in the book "The Tomes of Delphi Algorithms and Data Structures" by Julian Bucknall. Implementation for TList, TObjectList and descendant classes. It works with Delphi 2009 to XE7 and probably other versions as well:
http://alexandrecmachado.blogspot.com.br/2015/02/merge-sort-for-delphi.html
From similar question How Can I Replace StringList.Sort with a Stable Sort in Delphi?, linked here in comment by lkessler I need to copy to here really easy trick as mentioned in question.
You can easily make quick sort behave stable just by adding initial order numbers into data to sort and adding last comparation condition in CustomSort compare function to compare this initial order numbers.
Easy, fast and smart. Costs only one extra integer (or byte, or use some reserved storage like TComponent.Tag if You sort TComponents) on each sortable item and one initialization loop over them.
TObjectToSort = class
...
Index: Integer;
end;
function MyStableSortComparer(List: TStringList; Index1, Index2: Integer): Integer;
var
o1, o2: TObjectToSort;
begin
o1 := TObjectToSort(List.Objects[Index1]);
o2 := TObjectToSort(List.Objects[Index2]);
...
if Result = 0 then
Result := o1.Index - o2.Index;
end;
for i := 0 to MyStrtingList.Count - 1 do
TObjectToSort(MyStrtingList.Objects[i]).Index := i;
MyStrtingList.CustomSort(MyStableSortComparer);
For anyone using generics here is a ready-to-use implementation of insertion and merge sort, both stable sorting algorithms.
uses Generics.Defaults, Generics.Collections;
type
TMySort = class
public
class procedure InsertionSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>); static;
class procedure MergeSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>); static;
end;
implementation
class procedure TMySort.InsertionSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>);
var
UnsortedIdx, CompareIdx: Integer;
AItem: T;
begin
for UnsortedIdx := Succ(FirstIndex) to LastIndex do begin
AItem := AArray[UnsortedIdx];
CompareIdx := UnsortedIdx - 1;
while (CompareIdx >= FirstIndex) and (AComparer.Compare(AItem, AArray[CompareIdx]) < 0) do begin
AArray[CompareIdx + 1] := AArray[CompareIdx]; { shift the compared (bigger) item to the right }
Dec(CompareIdx);
end;
AArray[CompareIdx + 1] := AItem;
end;
end;
class procedure TMySort.MergeSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>);
const
MinMergeSortLimit = 16;
var
LeftLast, RightFirst: Integer;
LeftIdx, RightIdx, SortedIdx: Integer;
LeftCount: Integer;
TmpLeftArray: TArray<T>;
begin
if (LastIndex - FirstIndex) < MinMergeSortLimit then
{ sort small chunks with insertion sort (recursion ends here)}
TMySort.InsertionSort<T>(AArray, FirstIndex, LastIndex, AComparer)
else begin
{ MERGE SORT }
{ calculate the index for splitting the array in left and right halves }
LeftLast := (FirstIndex + LastIndex) div 2;
RightFirst := LeftLast + 1;
{ sort both halves of the array recursively }
TMySort.MergeSort<T>(AArray, FirstIndex, LeftLast, AComparer);
TMySort.MergeSort<T>(AArray, RightFirst, LastIndex, AComparer);
{ copy the first half of the array to a temporary array }
LeftCount := LeftLast - FirstIndex + 1;
TmpLeftArray := System.Copy(AArray, FirstIndex, LeftCount);
{ setup the loop variables }
LeftIdx := 0; { left array to merge -> moved to TmpLeftArray, starts at index 0 }
RightIdx := RightFirst; { right array to merge -> second half of AArray }
SortedIdx := FirstIndex - 1; { range of merged items }
{ merge item by item until one of the arrays is empty }
while (LeftIdx < LeftCount) and (RightIdx <= LastIndex) do begin
{ get the smaller item from the next items in both arrays and move it
each step will increase the sorted range by 1 and decrease the items still to merge by 1}
Inc(SortedIdx);
if AComparer.Compare(TmpLeftArray[LeftIdx], AArray[RightIdx]) <= 0 then begin
AArray[SortedIdx] := TmpLeftArray[LeftIdx];
Inc(LeftIdx);
end else begin
AArray[SortedIdx] := AArray[RightIdx];
Inc(RightIdx);
end;
end;
{ copy the rest of the left array, if there is any}
while (LeftIdx < LeftCount) do begin
Inc(SortedIdx);
AArray[SortedIdx] := TmpLeftArray[LeftIdx];
Inc(LeftIdx);
end;
{ any rest of the right array is already in place }
end;
end;
The implementation is made for arrays and applicable for TList/TObjectList too (as their Items property is an array).
var
AList: TList<T>;
AComparer: IComparer<T>;
begin
...
TMySort.MergeSort<T>(AList.List, 0, AList.Count-1, AComparer);
...
end;
Besides being stable, in my experience, this merge sort implementation does show better performance than the build-in quick sort (though it uses more memory).
I'd like to set the length of a dynamic array, as suggested in this post. I have two classes TMyClass and the related TChildClass defined as
TChildClass = class
private
FField1: string;
FField2: string;
end;
TMyClass = class
private
FField1: TChildClass;
FField2: Array of TChildClass;
end;
The array augmentation is implemented as
var
RContext: TRttiContext;
RType: TRttiType;
Val: TValue; // Contains the TMyClass instance
RField: TRttiField; // A field in the TMyClass instance
RElementType: TRttiType; // The kind of elements in the dyn array
DynArr: TRttiDynamicArrayType;
Value: TValue; // Holding an instance as referenced by an array element
ArrPointer: Pointer;
ArrValue: TValue;
ArrLength: LongInt;
i: integer;
begin
RContext := TRTTIContext.Create;
try
RType := RContext.GetType(TMyClass.ClassInfo);
Val := RType.GetMethod('Create').Invoke(RType.AsInstance.MetaclassType, []);
RField := RType.GetField('FField2');
if (RField.FieldType is TRttiDynamicArrayType) then begin
DynArr := (RField.FieldType as TRttiDynamicArrayType);
RElementType := DynArr.ElementType;
// Set the new length of the array
ArrValue := RField.GetValue(Val.AsObject);
ArrLength := 3; // Three seems like a nice number
ArrPointer := ArrValue.GetReferenceToRawData;
DynArraySetLength(ArrPointer, ArrValue.TypeInfo, 1, #ArrLength);
{ TODO : Fix 'Index out of bounds' }
WriteLn(ArrValue.IsArray, ' ', ArrValue.GetArrayLength);
if RElementType.IsInstance then begin
for i := 0 to ArrLength - 1 do begin
Value := RElementType.GetMethod('Create').Invoke(RElementType.AsInstance.MetaclassType, []);
ArrValue.SetArrayElement(i, Value);
// This is just a test, so let's clean up immediatly
Value.Free;
end;
end;
end;
ReadLn;
Val.AsObject.Free;
finally
RContext.Free;
end;
end.
Being new to D2010 RTTI, I suspected the error could depend on getting ArrValue from the class instance, but the subsequent WriteLn prints "TRUE", so I've ruled that out. Disappointingly, however, the same WriteLn reports that the size of ArrValue is 0, which is confirmed by the "Index out of bounds"-exception I get when trying to set any of the elements in the array (through ArrValue.SetArrayElement(i, Value);). Do anyone know what I'm doing wrong here? (Or perhaps there is a better way to do this?) TIA!
Dynamic arrays are kind of tricky to work with. They're reference counted, and the following comment inside DynArraySetLength should shed some light on the problem:
// If the heap object isn't shared (ref count = 1), just resize it. Otherwise, we make a copy
Your object is holding one reference to it, and so is the TValue. Also, GetReferenceToRawData gives you a pointer to the array. You need to say PPointer(GetReferenceToRawData)^ to get the actual array to pass to DynArraySetLength.
Once you've got that, you can resize it, but you're left with a copy. Then you have to set it back onto the original array.
TValue.Make(#ArrPointer, dynArr.Handle, ArrValue);
RField.SetValue(val.AsObject, arrValue);
All in all, it's probably a lot simpler to just use a list instead of an array. With D2010 you've got Generics.Collections available, which means you can make a TList<TChildClass> or TObjectList<TChildClass> and have all the benefits of a list class without losing type safety.
I think you should define the array as a separate type:
TMyArray = array of TMyClass;
and use that.
From an old RTTI based XML serializer I know the general method that you use should work (D7..2009 tested):
procedure TXMLImpl.ReadArray(const Name: string; TypeInfo: TArrayInformation; Data: Pointer; IO: TParameterInputOutput);
var
P: PChar;
L, D: Integer;
BT: TTypeInformation;
begin
FArrayType := '';
FArraySize := -1;
ComplexTypePrefix(Name, '');
try
// Get the element type info.
BT := TypeInfo.BaseType;
if not Assigned(BT) then RaiseSerializationReadError; // Not a supported datatype!
// Typecheck the array specifier.
if (FArrayType <> '') and (FArrayType <> GetTypeName(BT)) then RaiseSerializationReadError;
// Do we have a fixed size array or a dynamically sized array?
L := FArraySize;
if L >= 0 then begin
// Set the array
DynArraySetLength(PPointer(Data)^,TypeInfo.TypeInformation,1,#L);
// And restore he elements
D := TypeInfo.ElementSize;
P := PPointer(Data)^;
while L > 0 do begin
ReadElement(''{ArrayItemName},BT,P,IO); // we allow any array item name.
Inc(P,D);
Dec(L);
end;
end else begin
RaiseNotSupported;
end;
finally
ComplexTypePostfix;
end;
end;
Hope this helps..