I have this formula in CR
I initialize in the group header
shared stringvar array HandAr := [""];
shared numbervar x :=1;
shared numbervar y :=0;
then in the detail section
shared stringvar array HandAr;
shared numbervar x;
shared numbervar y;
(if CStr({Material_Location.Material_Location},"######",0,"","") in HandAr[x] then x := x+0 else
y := y+{Material_Location.On_Hand_Qty};
HandAr[x] := CStr({Material_Location.Material_Location},"######",0,"","");
ReDim preserve HandAr[UBound (HandAr)+1];
x := x+1;);
The formula never returns true
The correct detail formula would look like this:
shared stringvar array HandAr;
shared numbervar x;
shared numbervar y;
(if CStr({Material_Location.Material_Location},"######",0,"","") in HandAr then x := x+0 else
(
y := y+{Material_Location.On_Hand_Qty};
HandAr[x] := CStr({Material_Location.Material_Location},"######",0,"","");
ReDim preserve HandAr[UBound (HandAr)+1];
x := x+1;
)
);
Where the following changes were made:
brackets around commands in else block (I guessed from your last comment that's the way you wanted it to work)
in if condition in HandAr instead of in HandAr[x], to compare with all array elements
Related
I have two reports set up the same way one works yet the other does not.
I initialize the variables in the first group
shared StringVar Array WcAr := [""];
shared StringVar Array ShAr := [""];
shared StringVar Shstr :="";
shared StringVar Array RhAr := [""];
shared StringVar Array UcAr := [""];
shared StringVar Array TcAr := [""];
shared StringVar Array BuAr := [""];
shared StringVar Array RqAr := [""];
shared StringVar Array SqAr := [""];
shared StringVar Array BcAr := [""];
shared NumberVar x := 1;
I then load the array in Group 4(Work Center)
shared StringVar Array WcAr;
shared StringVar Array ShAr;
shared StringVar Shstr :="";
shared StringVar Array RhAr;
shared StringVar Array UcAr;
shared StringVar Array TcAr;
shared StringVar Array BuAr;
shared StringVar Array RqAr;
shared StringVar Array SqAr;
shared StringVar Array BcAr;
shared NumberVar x;
(if not IsNull({#Work Center}) then WcAr [x] := {#Work Center};
ReDim preserve WcAr[UBound (WcAr)+1];
ShAr [x] := Cstr({Job_Operation.Act_Setup_Hrs},"####.##",2,",",".");
ReDim preserve ShAr[UBound (ShAr)+1];
RhAr [x] := Cstr({Job_Operation.Act_Run_Hrs},"####.##",2,",",".");
ReDim preserve RhAr[UBound (RhAr)+1];
UcAr [x] := Cstr({Job_Operation.Act_Unit_Cost},"####.##",2,",",".");
ReDim preserve UcAr[UBound (UcAr)+1];
TcAr [x] := Cstr({Job_Operation.Act_Total_Cost}+
{Job_Operation.Act_Run_Labor},"####.##",2,",",".");
ReDim preserve TcAr[UBound (TcAr)+1];
x := x+1;);
I output these in the group footer using for each array
shared StringVar Array WcAr;
Join(WcAr,ChrW(10));
Only the first item is added to any of the arrays. x has incremented and is equal to 17 which indicates it going through the formula. I have tried without the if statement and anything else I can think of but I always get the same result.
That should work, at least for your WcAr. As you're using Chr(10) as divider for the array elements, I guess you just see only the first element because the field formatting does not allow it to increase. => Either activate "Can grow" in output field format, or use another divider.
My test scenario is these three formulae, where COMMAND.STRING is the input field of course:
init
shared StringVar Array WcAr := [""];
shared NumberVar x := 1;
add
shared StringVar Array WcAr;
shared NumberVar x;
WcAr [x] := {COMMAND.STRING};
ReDim preserve WcAr[UBound (WcAr)+1];
x := x+1;
output
shared StringVar Array WcAr;
Join(WcAr,',');
Important: The add formula field must be placed in a repeated section, in my case it's the detail section, inyour case probably a group header. The output formula can only show the collected values when it's placed in a section after the one where the last value is collected (or in it).
I need to remove all duplicate values from an array of integer, yet maintain the order of the elements:
Example:
10,20,20(duplicate),10(duplicate),50
Becomes:
10,20,50
Create a dictionary with Integer as the key. The value type is immaterial.
Iterate through the input array. For each value in the input array, check whether or not that value is in the dictionary.
If yes, this is a duplicate, discard.
If no, this is the first time the value has been encountered. Retain the value, and add it to the dictionary.
The point of the dictionary is that it can perform O(1) lookup.
In pseudocode:
var
arr: TArray<Integer>; // input and output
Dict: TDictionary<Integer, Integer>;
SrcIndex, DestIndex: Integer;
....
DestIndex := 0;
for SrcIndex := 0 to high(arr) do begin
Value := arr[SrcIndex];
if not Dict.ContainsKey(Value) then begin
arr[DestIndex] := arr[SrcIndex];
Dict.Add(Value, 0);
inc(DestIndex);
end;
end;
SetLength(arr, DestIndex);
Obviously you need to create, and destroy, the dictionary. I'm assuming you know how to do that. And I've opted to modify the array in place but you could equally create a new array if you prefer.
heres a version without dictionary.
procedure TForm1.RemoveDuplicates;
var
i,j,k,tot,mov:integer;
arr:array of integer;
begin
arr := [10,20,30,40,30,20,10,10,50,10,20,40];
tot := 0;
for i := 0 to length(arr)-1 do
begin
if i >= length(arr)-tot-1 then
break;
for j := i + 1 to length(arr)-1-tot do
begin
if j >= length(arr)-tot-1 then
break;
mov := 0;
while arr[i] = arr[j] do
begin
inc(mov);
arr[j] := arr[j+mov];
end;
tot := tot + mov;
if mov>0 then
for k := j+1 to length(arr)-1-tot do
arr[k] := arr[k+mov];
end;
end;
SetLength(arr,length(arr)-tot-1);
end;
I have multiple arrays and they all start with integer fields, from 1 up to 5 fields, and these are like indexes that need to be sorted, from min to max:
TArrayA = record
Field1:integer;
Field2:integer;
Field3:integer;
Field4:integer;
Field5:integer;
... //other fields, strings, integers... up to 50 fields
end;
ArrayA:=array of TArrrayA;
Currently I use this approach to sort:
// sort by Field1
top:=Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if ArrayA[look].Field1 < ArrayA[min].Field1 then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// now sort by Field2
top:=Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) And
(ArrayA[look].Field2 < ArrayA[min].Field2) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
This does the job. Although is a bit slow when I need to sort all 5 fields,
and this is how I do it, field by field, so I sort the array 5 times. Is there any better, faster way?
Here is example:
procedure TForm1.Button8Click(Sender: TObject);
type
TArrayA = record
Field1: integer;
Field2: integer;
Field3: integer;
Field4: integer;
Field5: integer;
end;
var
ArrayA: array of TArrayA;
vTmpRecord: TArrayA;
top, counter, min, max, look: integer;
i,t1,t2:integer;
begin
SetLength(ArrayA,100000);
for i := 0 to 99999 do
begin
ArrayA[i].Field1:=1+Random(100);
ArrayA[i].Field2:=1+Random(100);
ArrayA[i].Field3:=1+Random(100);
ArrayA[i].Field4:=1+Random(100);
ArrayA[i].Field5:=1+Random(100);
end;
t1:=GetTickCount;
// sort by Field1
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if ArrayA[look].Field1 < ArrayA[min].Field1 then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field2
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and
(ArrayA[look].Field2 < ArrayA[min].Field2) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field3
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and (ArrayA[look].Field2 = ArrayA[min].Field2) and
(ArrayA[look].Field3 < ArrayA[min].Field3) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field4
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and (ArrayA[look].Field2 = ArrayA[min].Field2) and (ArrayA[look].Field3 = ArrayA[min].Field3) and
(ArrayA[look].Field4 < ArrayA[min].Field4) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field5
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and (ArrayA[look].Field2 = ArrayA[min].Field2) and (ArrayA[look].Field3 = ArrayA[min].Field3) and (ArrayA[look].Field4 = ArrayA[min].Field4) and
(ArrayA[look].Field5 < ArrayA[min].Field5) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
t2:=GetTickCount;
Button8.Caption:=IntToStr(t2-t1);
end;
You can use built in Quick sort method for sorting arrays with your custom comparer:
uses
System.Math,
System.Generics.Defaults,
System.Generics.Collections;
TArray.Sort<TArrayA>(ArrayA, TComparer<TArrayA>.Construct( function(const Left, Right: TArrayA): Integer
begin
if Left.Field1 = Right.Field1 then
begin
if Left.Field2 = Right.Field2 then
begin
Result := CompareValue(Left.Field3, Right.Field3);
end
else Result := CompareValue(Left.Field2, Right.Field2);
end
else Result := CompareValue(Left.Field1, Right.Field1);
end
));
I added code only for first three fields, but you will get the picture how to build your own comparer for more fields.
The most important thing for you to do is to separate the sort algorithm from the data. That way you can write, or use, a single sort algorithm again and again with different data
The classic way to do that is to use a comparison sort. They are sort algorithms that require a compare function that compares two items and returns a negative integer for less than, a positive integer for greater than, and zero when equal.
So, let's start by demonstrating such a compare function for your data. Storing multiple fields as you have makes it hard to write a general purpose comparer. Better to put the fields in an array. Once you have done so you can do the compare lexicographically using iteration like this:
function CompareIntegerArray(const lhs, rhs: array of Integer): Integer;
var
i: Integer;
begin
Assert(Length(lhs) = Length(rhs));
for i := low(lhs) to high(lhs) do
if lhs[i] < rhs[i] then
exit(-1)
else if lhs[i] > rhs[i] then
exit(1);
exit(0);
end;
With a lexicographic order we first compare the primary field. If they differ we have our answer, otherwise we move on to the secondary field. And so on. Such an algorithm is well suited to iteration as demonstrated above.
This overcomes a significant weakness in your approach, by sorting the array once only.
Once you have this compare function you need to wrap it in an outer compare function that extracts data from the record fields and populates arrays. Perhaps along these lines:
type
TMyArray = array [1..5] of Integer;
function GetMyArray(const Value: TArrayA): TMyArray;
begin
Result[1] := Value.Field1;
Result[2] := Value.Field2;
....
end;
function MyCompare(const lhs, rhs: TArrayA): Integer;
begin
Result := CompareIntegerArray(
GetMyArray(lhs),
GetMyArray(rhs)
);
end;
Now, as promised, you can use this compare function with a general purpose sort like TArray.Sort<T> from Generics.Collections. This is an implementation of Quicksort, a comparison sort with average complexity of O(n log n). That will typically yield a huge benefit over your O(n2) bubble sort.
Life would be simpler if you could replace the record with an actual array. Another option that might be useful would be to add a method to the record that returned an array of integer ready for use in the lexicographic compare function.
To recap:
Separate data, comparison and sorting to facilitate re-use and clarity.
Use arrays to enable lexicographic compare to be implemented with a loop.
Use an efficient sort algorithm such as Quicksort.
This might seem like a strange request, but there is a good reason (code generation application). I pass a variant array to a procedure, contained within an array of variants, as follows:
TVarArray = array of variant;
procedure TMainForm.Button1Click(Sender: TObject);
var
params: TVarArray;
numRows: integer;
numCols: integer;
i: integer;
j: integer;
begin
SetLength(params, 2);
numRows := 2;
numCols := 2;
params[0] := 5;
params[1] := VarArrayCreate([1, numRows, 1, numCols], varVariant);
for i := 1 to numRows do
for j := 1 to numCols do
params[1][i, j] := i + j;
TestProc(params);
end;
procedure TMainForm.TestProc(params: TVarArray);
var
arr: variant;
p: PVariant;
v: variant;
begin
arr := params[1]; // -- Copies the array to arr.
arr[2, 2] := 99;
p := #(params[1]);
p^[2, 2] := 88; // -- Directly reference the passed-in array.
v := p^; // -- Copies the array to v -> How to prevent?
v[2, 2] := 77; // -- This should change the value in the original array.
edit1.Text := VarToStr(arr[2, 2]); // -- 99
edit2.Text := VarToStr(params[1][2, 2]); // -- 88 - should be 77
edit3.Text := VarToStr(v[2, 2]); // -- 77
end;
I don't want to create a copy of the array, so could use p^[] to directly access the passed-in array. However, I don't want to use the p^ syntax in TestProc but would prefer to use a variable name without the ^. Of course, if I try v := p^ I just get a copy. Is there any way around this? Thanks!
What you're looking for is a local variable that can act as a reference for something else (in particular, an element in an array of Variant). However, Delphi provides no way of creating a "local reference" variable. References only exist in the context of parameters passed as var, out, or sometimes const.
Maybe you could introduce a subroutine and pass param[1] as a var parameter. Inside the subroutine, you could refer to that parameter, and it would alias the array element form the caller. For example:
procedure ModifyVariant(var p: Variant);
begin
p[2, 2] := 77;
end;
procedure TMainForm.TestProc(params: TVarArray);
var
p: PVariant;
begin
p := #params[1];
ModifyVariant(params[1]);
Assert(params[1][2, 2] = p^[2, 2]);
end;
ModifyVariant could even be an anonymous procedure so you can implement within the same scope as the caller:
procedure TMainForm.TestProc(params: TVarArray);
var
ModifyVariant: reference to procedure(var x: Variant);
p: PVariant;
begin
p := #params[1];
ModifyVariant := procedure(var v: Variant)
begin
v[2, 2] := 77;
end;
ModifyVariant(params[1]);
Assert(params[1][2, 2] = p^[2, 2]);
end;
Neither of those looks particularly appealing, though, especially if you're afraid that mere pointer access will "spook" your code's consumers.
You've mentioned that you expect your users to incorporate their own code into the code you're generating. I wouldn't advise that. After all, what are they expected to do after they re-run your code generator? Surely they'll lose whatever customizations they've made. It's better to keep generated code separate, ideally in a separate file. For user customization, you can provide hooks in the form of callback functions that users can implement. That way, for example, a user could provide something analogous to ModifyVariant, and then your generated code can simply call it. You'll have your "Variant references," and you'll have generated code cleanly separated from user code.
I'm trying to convert a variant array (of doubles, but it could be anything I guess) to a dynamic array. I usually use the DynArrayFromVariant and DynArrayToVariant procedures, but in this case my variant arrays are 1 based. These two functions only seem to work on 0 based arrays. Any idea how I could do what I need to do?
If you know the type of your array elements you can write more efficient (while less generic) code:
function DoubleDynArrayFromVarArray(const V: Variant): TDoubleDynArray;
var
P: Pointer;
Count: Integer;
begin
Result := nil;
if not VarIsArray(V) or (VarType(V) and varTypeMask <> varDouble) or
(VarArrayDimCount(V) <> 1) then
raise EVariantInvalidArgError.Create(SVarInvalid);
Count := VarArrayHighBound(V, 1) - VarArrayLowBound(V, 1) + 1;
if Count = 0 then
Exit;
P := VarArrayLock(V);
try
SetLength(Result, Count);
Move(P^, Result[0], Count * SizeOf(Double));
finally
VarArrayUnlock(V);
end;
end;