I want to compute a list "intersection". The problem is:
L1 = [1, 0, 2, 3, 1 , 3, 0, 5]
L2 = [3, 5]
Then the result will be
L3 = [0, 0, 0, 1, 0, 1, 0, 1]
Then i will convert this result in a byte. In this case will be 21 in decimal format.
I want to make in delphi and I need this do efficiently. Is there a way to solve this problem better than O(m*n)?
Here's a function that should do what you want. I defined L2 as a set instead of an array since you said all your values will fit in a Byte. Its complexity is O(n); checking set membership runs in constant time. But since the result needs to fit in a byte, the length of L1 must be bound at 8, so the complexity of this function is actually O(1).
function ArrayMembersInSet(const L1: array of Byte; const L2: set of Byte): Byte;
var
i: Integer;
b: Byte;
begin
Assert(Length(L1) <= 8,
'List is to long to fit in result');
Result := 0;
for i := 0 to High(L1) do begin
b := L1[i];
if b in L2 then
Result := Result or (1 shl (7 - i));
end;
end;
Rob's answer will work for this specific case. For a more general case where two lists have to be compared, you can do it in O(m+n) time if both lists are sorted. (Or O(n log n) time if you have to sort them first, but that's still a lot faster than O(m*n).)
The basic List Comparison algorithm looks like this:
procedure ListCompare(list1, list2: TWhateverList; [Add extra params here]);
var
i, j: integer;
begin
i := 0;
j := 0;
while (i < list1.Count) and (j < list2.Count) do
begin
if list1[i] < list2[j] then
begin
//handle this appropriately
inc(i);
end
else if list1[i] > list2[j] then
begin
//handle this appropriately
inc(j);
end
else //both elements are equal
begin
//handle this appropriately
inc(i);
inc(j);
end;
end;
//optional cleanup, if needed:
while (i < list1.Count) do
begin
//handle this appropriately
inc(i);
end;
while (j < list2.Count) do
begin
//handle this appropriately
inc(j);
end;
end;
This can be customized for a whole bunch of tasks, including list intersection, by changing the "handle this appropriately" places, and it's guaranteed to not run for more steps than are in both lists put together. For list intersection, have the equals case add the value to some output and the other two do nothing but advance the counters, and you can leave off the optional cleanup.
One way to use this algorithm is to make the extra params at the top into function pointers and pass in routines that will handle the appropriate cases, or nil to do nothing. (Just make sure you check for nil before invoking them if you go that route!) That way you only have to write the basic code once.
Well no matter what you will need to visit each element in each list comparing the values. A nested loop would accomplish this in O(n^2) and the conversion should just be local work.
EDIT: I noticed that you want a better runtime than O(n*m).
Related
This question already has an answer here:
How array type assignment works?
(1 answer)
Closed 8 years ago.
I'd like to know if anyone could point me out to what would be the difference when using the two different copy approaches for array, which is defined as type.
I needed to make a function that would order the elements of integers in dynamic array, from either min to max or max to min. Therefore, I created a new type like this:
type IntArray = array of integer;
Then I defined a function to sort, with two directions, which are identified by integer passed, with parameter being 0 to sort towards minimum (max -> min) or 1 to sort towards max (min -> max).
function SortArray(ToSort: IntArray; Direction: integer): IntArray;
var count, i: integer;
Label Label1, Label2;
begin
count:=Length(ToSort);
if (Direction = 1) then
begin
Label1:
for i := 0 to count-2 do
begin
if ToSort[i+1] > ToSort[i] then
begin
ToSort[i+1] :=ToSort[i] +ToSort[i+1];
ToSort[i] :=ToSort[i+1] -ToSort[i];
ToSort[i+1] :=ToSort[i+1] -ToSort[i];
GoTo Label1;
end;
end;
end
else
if (Direction = 0) then
begin
Label2:
for i := 0 to count-2 do
begin
if ToSort[i+1] < ToSort[i] then
begin
ToSort[i+1] :=ToSort[i] +ToSort[i+1];
ToSort[i] :=ToSort[i+1] -ToSort[i];
ToSort[i+1] :=ToSort[i+1] -ToSort[i];
GoTo Label2;
end;
end;
end;
Result:=ToSort;
Now, this function works fine as it seems, however the result differs regarding how I define the arrays that are passed to the function call;
I have an OnClick event for a button, which gives two calls of the function:
procedure Button1Click(Sender: TObject);
var a, b: IntArray;
i: Integer;
begin
SetLength(a, 10);
SetLength(b, 10);
for i := 0 to 9 do
begin
a[i]:=Random(100);
b[i]:=a[i]; // Example 1;
end;
// b:=a; // Example 2;
a:=SortArray(a, 1);
b:=SortArray(b, 0);
for i := 0 to 9 do
begin
Listbox1.Items.Add(InttoStr(a[i]));
Listbox2.Items.Add(InttoStr(b[i]));
end;
end;
Now the thing is, if I define array B the way it is provided with example 1, -> the function works fine. A is sorted towards maximum, while B is sorted towards minimum;
However, if I define array B the way it is provided with example 2, -> the function gives me the same result for both calls, both being arrays sorted towards maximum (as called in the first call).
Why does it make a difference how I define array b, and why shouldn't I copy it directly as var to var?
Doesn't seem to make much sense to me at this point...
In example 1, you're looping through and assigning the value of each element in a to the corresponding slot in b. You have two separate arrays, with totally separate content.
b[i] := a[i];
So sorting works on each independent array, and things work as you intend. You can verify this by setting them to different values and then inspecting the elements to confirm they're in fact different:
a[0] := 1;
b[i] := 2; // Inspecting shows a[0] <> b[0].
In example 2, you're setting b to point to a, which means that accessing b[1] is actually accessing the same memory location as a[1]. You only have one array (a), with two references to it (a and b). Sorting is actually working on a single array, so all you're doing is first sorting the array in ascending order and then resorting the same array (through the second reference) in descending order, and you don't get the results you expect.
You can confirm this by again setting them to different values and then inspecting the elements, but this time they'll be the same value:
b := a;
a[0] := 1;
b[0] := 2; // Both a[0] and b[0] now contain the value 2.
I came across the following (conceptually very simple) problem, and want to write code to do it, but am struggling. Let's say we have two rows of equal length, k. Each cell of each row can be either a 0 or a 1.
For e.g., consider the following row-pair, with k = 5: 01011, 00110
Now if the two rows could freely exchange values at each cell, there would be 2^5 possible combinations of row-pairs (some of which may not be unique). For instance, we could have 00010, 01111 as one possible row-pair from the above data. I want to write code in Delphi to list all the possible row-pairs. This is easy enough to do with a set of nested for-loops. However, if the value of k is known only at run-time, I'm not sure how I can use this approach for I don't know how many index variables I would need. I can't see how case statements will help either because I don't know the value of k.
I am hoping that there is an alternative to a nested for-loop, but any thoughts would be appreciated. Thanks.
Given two vectors A and B of length k, we can generate a new pair of vectors A1 and B1 by selectively choosing elements from A or B. Let our decision to choose from A or B be dictated by a bit vector S, also of length k. For i in [0..k), when Si is 0, store Ai in A1i and Bi in B1i. If Si is 1, then vice versa.
We can define that in Delphi with a function like this:
procedure GeneratePair(const A, B: string; S: Cardinal; out A1, B1: string);
var
k: Cardinal;
i: Cardinal;
begin
Assert(Length(A) = Length(B));
k := Length(A);
Assert(k <= 32);
SetLength(A1, k);
SetLength(B1, k);
for i := 1 to k do
if (S and (1 shl Pred(i))) = 0 then begin
A1[i] := A[i];
B1[i] := B[i];
end else begin
A1[i] := B[i];
B1[i] := A[i];
end;
end;
If we count in binary from 0 to 2k−1, that will give us a sequence of bit vectors representing all the possible combinations of exchanging or not-exchanging characters between A and B.
We can write a loop and use the above function to generate all 2k combinations:
A := '01011';
B := '00110';
for S := 0 to Pred(Round(IntPower(2, Length(A)))) do begin
GeneratePair(A, B, S, A1, B1);
writeln(A1, ', ', B1);
end;
That effectively uses one set of nested loops. The outer loop is the one from 0 to 31. The inner loop is the one inside the function from 1 to k. As you can see, we don't need to know the value of k in advance.
Now that, thanks to Rob, I understand the problem, I offer this recursive solution:
{$APPTYPE CONSOLE}
procedure Swap(var A, B: Char);
var
temp: Char;
begin
temp := A;
A := B;
B := temp;
end;
procedure Generate(const A, B: string; Index: Integer);
var
A1, B1: string;
begin
Assert(Length(A)=Length(B));
inc(Index);
if Index>Length(A) then // termination
Writeln(A, ', ', B)
else
begin // recurse
// no swap
Generate(A, B, Index);
//swap
A1 := A;
B1 := B;
Swap(A1[Index], B1[Index]);
Generate(A1, B1, Index);
end;
end;
begin
Generate('01011', '00110', 0);
Readln;
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'd like to have a Pos() adapted to be used specifying boundaries within the Source string, rather than have it perform the search in the entire data.
Let's say I have a string which is 100 chars long, I want to perform the Pos only between the 5th and 20th character of the (unicode/utf8) string.
The code should be adapted from the ASM fastcode implementation in delphi, and obviously avoid pre-copying the portion of the string to a temporal one, as the purpose is making it faster than that.
My scenario:
I have a string which is accessed many times, and each time, a portion of it is copied to another temporal string, then a Pos is performed on it. I want to avoid the intermediary copy every time, and rather perform the Pos within the boundaries I specify.
Edit: question edited after new one was deemed a duplicate.
I would still like a solution that expands on the current XE3 FastCode assembly implementation, as that would fit my goal here.
Here is an alternative that is not based on asm.
It will also work on a 64-bit application.
function PosExUBound(const SubStr, Str: UnicodeString; Offset,EndPos: Integer): Integer; overload;
var
I, LIterCnt, L, J: NativeInt;
PSubStr, PS: PWideChar;
begin
L := Length(SubStr);
if (EndPos > Length(Str)) then
EndPos := Length(Str);
{ Calculate the number of possible iterations. Not valid if Offset < 1. }
LIterCnt := EndPos - Offset - L + 1;
{- Only continue if the number of iterations is positive or zero (there is space to check) }
if (Offset > 0) and (LIterCnt >= 0) and (L > 0) then
begin
PSubStr := PWideChar(SubStr);
PS := PWideChar(Str);
Inc(PS, Offset - 1);
Dec(L);
I := 0;
J := L;
repeat
if PS[I + J] <> PSubStr[J] then
begin
Inc(I);
J := L;
Dec(LIterCnt);
if (LIterCnt < 0)
then Exit(0);
end
else
if (J > 0) then
Dec(J)
else
Exit(I + Offset);
until false;
end;
Result := 0;
end;
I will leave it as an excercise to implement an AnsiString overloaded version.
BTW, the purepascal parts of the Pos() functions in XE3 are to put it mildly poorly written. See QC111103 Inefficient loop in Pos() for purepascal. Give it a vote if you like.
I'm trying to write a function that will take an array on input and return array of arrays, containing all possible subsets of input array (power set without empty element). For example for input: [1, 2, 3] the result would be [[1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2, 3]].
This function does the job in python:
def list_powerset(lst):
result = [[]]
for x in lst:
result += [subset + [x] for subset in result]
result.pop(0)
return result
But I'm looking for implementation of it in Delphi. Is this possible to accomplish this way or should I look for something else?
type
TIdArray = array of Integer;
TPowerSet = array of TIdArray;
function PowerSet(Ids: TIdArray): TPowerSet;
// Implementation loosely based on the explanation on
// http://www.mathsisfun.com/sets/power-set.html
var
TotalCombinations: Integer;
TotalItems: Integer;
Combination: Integer;
SourceItem: Integer;
ResultItem: Integer;
Bit, Bits: Integer;
begin
TotalItems := Length(Ids);
// Total number of combination for array of n items = 2 ^ n.
TotalCombinations := 1 shl TotalItems;
SetLength(Result, TotalCombinations);
for Combination := 0 to TotalCombinations - 1 do
begin
// The Combination variable contains a bitmask that tells us which items
// to take from the array to construct the current combination.
// Disadvantage is that because of this method, the input array may contain
// at most 32 items.
// Count the number of bits set in Combination. This is the number of items
// we need to allocate for this combination.
Bits := 0;
for Bit := 0 to TotalItems - 1 do
if Combination and (1 shl Bit) <> 0 then
Inc(Bits);
// Allocate the items.
SetLength(Result[Combination], Bits);
// Copy the right items to the current result item.
ResultItem := 0;
for SourceItem := 0 to TotalItems - 1 do
if Combination and (1 shl SourceItem) <> 0 then
begin
Result[Combination][ResultItem] := Ids[SourceItem];
Inc(ResultItem);
end;
end;
end;
My other answer is a piece of code I created a while ago when I needed in in Delphi 2007. To make it more generic, you can use generics. Now I haven't actually used generics before, but it seems to work like this. I must admit I had to peek here to check the syntax. If there's an easier way, I hope someone else can post it.
The code is in fact practically unaltered, except the name of the input parameter. (Yay, generics!)
type
TGenericArray<T> = array of T;
TGenericPowerSet<T> = array of array of T;
TPowerSet<T> = class(TObject)
public
class function Get(a: TGenericArray<T>): TGenericPowerSet<T>;
end;
class function TPowerSet<T>.Get(a: TGenericArray<T>): TGenericPowerSet<T>;
var
TotalCombinations: Integer;
TotalItems: Integer;
Combination: Integer;
SourceItem: Integer;
ResultItemIncluded: Integer;
Bit, Bits: Integer;
begin
TotalItems := Length(a);
// Total number of combination for array of n items = 2 ^ n.
TotalCombinations := 1 shl TotalItems;
SetLength(Result, TotalCombinations);
for Combination := 0 to TotalCombinations - 1 do
begin
// The Combination variable contains a bitmask that tells us which items
// to take from the array to construct the current combination.
// Disadvantage is that because of this method, the input array may contain
// at most 32 items.
// Count the number of bits set in Combination. This is the number of items
// we need to allocate for this combination.
Bits := 0;
for Bit := 0 to TotalItems - 1 do
if Combination and (1 shl Bit) <> 0 then
Inc(Bits);
// Allocate the items.
SetLength(Result[Combination], Bits);
// Copy the right items to the current result item.
ResultItemIncluded := 0;
for SourceItem := 0 to TotalItems - 1 do
if Combination and (1 shl SourceItem) <> 0 then
begin
Result[Combination][ResultItemIncluded] := a[SourceItem];
Inc(ResultItemIncluded);
end;
end;
end;
And use like this:
var
p: TPowerSet<String>;
a: TGenericArray<String>;
r: TGenericPowerSet<String>;
begin
SetLength(a, 2);
a[0] := 'aaa';
a[1] := 'bbb';
r := p.Get(a);
ShowMessage(IntToStr(Length(r)));
ShowMessage(r[1][0]);