i have some problem again about list and binarysearch. In general, i have:
type
TMyArr = array [1..5] of Integer;
PMyList = record
Comb: TMyArr;
... // other fields
end;
TMyList = TList<PMyList>;
var
MyArr: TMyArr;
MyList: TMyList;
rMyList: PMyList;
i load value in array MyArr and want find element MyArr (with all values in it) in list TMyList, then i use:
rMyList.Comb := MyArr;
MyList.BinarySearch(rMyList, iIndex3, TDelegatedComparer<PMyList>.Construct(Compare));
with Compare so defined:
function CompareInt(const Left, Right: Integer): Integer;
begin
if Left < Right then
Result := -1
else if Left > Right then
Result := 1
else
Result := 0;
end;
function Compare(const Left, Right: PMyList): Integer;
begin
Result := CompareInt(Left.Comb[1], Right.Comb[1]);
if Result = 0 then
Result := CompareInt(Left.Comb[2], Right.Comb[2]);
if Result = 0 then
Result := CompareInt(Left.Comb[3], Right.Comb[3]);
if Result = 0 then
Result := CompareInt(Left.Comb[4], Right.Comb[4]);
if Result = 0 then
Result := CompareInt(Left.Comb[5], Right.Comb[5]);
end;
Now, my problem is that not every result is correct. In sense that often i have correct index of element and other time i have other index corresponding to other element, in casual.
As i can solve it? Where i have mistake?
I want only find index corresponding of MyArr in TMyArr.
Thanks again very much.
Your Compare function is just fine. If the binary search fails to work correctly then that can only be because the list is not ordered by the order defined by Compare. Call the Sort function on the list once you have finished populating, and before you start searching. When you call Sort, you must make sure that it use your compare function.
Related
I know how to remove duplicate strings from a TStringList using dupignore for a sorted Tstringlist.
CallData := TStringList.Create;
CallData.Sorted := True;
Call.Duplicates := dupIgnore;
But in my case strings must not be sorted .
Using a FOR loop finding duplicates is very slow (also using indexOF())when TStringList has hundreds of thousands of lines .
if OpenDialog1.Execute then
begin
Try
y := TStringList.create;
f := TStreamReader.create(OpenDialog1.FileName, TEncoding.UTF8, True);
while not f.EndOfStream do
begin
l := f.ReadLine;
X.Add(l);
end;
g := Tstreamwriter.create('d:\logX.txt', True, TEncoding.UTF8);
for I := 0 to X.count - 1 do
begin
if y.IndexOf(X[I]) = -1 then
y.Add(X[I]);
end;
for j := 0 to y.count - 1 do
g.WriteLine(y[j]);
Finally
f.free;
y.free;
g.free;
End;
end;
is there any better way ?
Here's how I would approach this problem:
Create a dictionary keyed on a string. It doesn't matter that the value type is.
Iterate through the string list in reverse order.
For each string, check whether or not it is in the dictionary.
If it is in the dictionary, remove from the string list. Otherwise add to the dictionary.
If there are a large number of duplicates to be removed then the performance of the above will be affected by repeated removal from the string list. That's because each item to be removed results in the later items being shifted down one index. You can avoid this by copying into a new list rather than deleting inplace.
Alternatively, you can operate in place like this:
Create a dictionary keyed on a string. It doesn't matter that the value type is.
Initialise a variable named Count to zero.
Iterate through the string list in forward order.
For each string, check whether or not it is in the dictionary.
If it is in the dictionary, do nothing. Otherwise add to the dictionary, copy into index Count of the list, and then increment Count.
Once the iteration is complete, resize the list to have Count elements.
The point of the dictionary is that lookup is an O(1) operation and so the second algorithm has O(n) time complexity.
I would use trickery, by having a sorted and an unsorted list. Like this:
y := TStringList.create;
s := TStringList.create;
s.Sorted := TRUE;
s.Duplicates := dupIgnore;
f := TStreamReader.create(OpenDialog1.FileName, TEncoding.UTF8, True);
while not f.EndOfStream do
begin
l := f.ReadLine;
s.Add(l);
if s.Count > y.Count then y.Add(l);
end;
// etc.
function compareobjects
(list : Tstringlist;
index1 : integer;
index2 : integer
) : integer;
begin
if index1 = index2 then
result := 0
else
if integer(list.objects[index1]) < integer(list.objects[index2]) then
result := -1
else
result := 1;
end;
begin
Try
y := TStringList.create;
y.Sorted := true;
y.Duplicates := dupignore;
f := TStreamReader.create('c:\106x\q47780823.bat');
i := 0;
while not f.EndOfStream do
begin
inc(i);
line := f.readline;
y.Addobject(line,tobject(i));
end;
y.Sorted := false;
y.CustomSort(compareobjects);
for i := 0 to y.count - 1 do
WriteLn(y[i]);
Finally
f.free;
y.free;
End;
readln;
end.
I'd keep track of the line number (i) and assign it with the string by casting as an object; sort the list and remove duplicates as before, but then un-sort it using a custom sort on the objects.
I have a listview which displays text from a loaded dataset.
I need to remove unwanted words that I listed in a listbox.
How to do that in delphi? I tried to convert the items to a text in the listview but the code didn't work for me..
Here's what I wrote:
var
counter,k : Integer; //counters
begin
counter := 0;
k:=0;
while counter <= listview1.Items.Count do
for k := 0 to Listbox1.items.Count-1 do
if listview1.Items.item[counter].Caption=listbox1.items[k] then
begin
listview1.Items.item[counter].Delete;
inc(counter)
end;
end;
There's multiple things wrong with the code:
You're only incrementing counter when you find a match, hence the
loop will not terminate if you don't.
You're using <= in the head of your while-loop, that will lead to
an Access Violation in the last iteration, since you access
the (n+1)-th element in the ListView with n elements.
If you modify the ListView while iterating over it, you have to
iterate from the back to the front. Suppose you find a match for the
first item of the ListView, you will delete it, and
ListView1.Items[counter] will be the item that was at index counter+1
previously. You can avoid that by changing the order of the iteration
(since deleting an element will not influence the following iterations), and breaking if you find a match.
Also, non-critical, but a question of coding style:
You don't have to initialize loop variables for a for-loop (and the
compiler should have hinted that the value assigned to k in line 2 is
never used, which you shouldn't ignore)
If you have a known number of iterations to perform, as you do for
the outer loop, you usually want to use a for-loop.
Your accessing of the items looks a little weird, though it probably
works.
TL;DR, here's how I would write the code:
procedure TForm1.Button2Click(Sender: TObject);
var counter,k: integer;
begin
for counter := ListView1.Items.Count-1 downto 0 do
for k := 0 to ListBox1.items.Count-1 do
if ListView1.Items[counter].Caption = ListBox1.Items[k] then
begin
ListView1.Items.Delete(counter);
Break;
end;
end;
You increment the outer counter counter in the wrong place. It is easier to code the counter to count backwards when you delete items that are indexed by the counter. Try this:
var
counter,k : Integer; //counters
begin
// counter := 0;
// k:=0;
for counter := listview1.Items.Count-1 downto 0 do
begin
for k := 0 to Listbox1.items.Count-1 do
if listview1.Items.item[counter].Caption=listbox1.items[k] then
begin
listview1.Items.item[counter].Delete;
Break;
end;
end;
end;
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.
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 have this problem: starting from an empty list (0 elements) i want check if an element is present or not present in this list. In case this record not is present in list then i add this record to list, otherwise update element in list.
I have tried writing this code:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Generics.Collections, System.Generics.Defaults;
type
TDBStats = record
Comb: Integer;
Freq: Integer;
end;
TDBStatsList = TList<TDBStats>;
procedure Add(ODBStats: TDBStatsList; const Item: TDBStats);
var
rItem: TDBStats;
begin
rItem := Item;
rItem.Freq := 1;
oDBStats.Add(rItem);
end;
procedure Update(ODBStats: TDBStatsList; const Item: TDBStats; const Index: Integer);
var
rItem: TDBStats;
begin
rItem := Item;
Inc(rItem.Freq);
oDBStats[Index] := rItem;
end;
var
oDBStats: TDBStatsList;
rDBStats: TDBStats;
myArr: array [0..4] of integer;
iIndex1: Integer;
begin
try
myArr[0] := 10;
myArr[1] := 20;
myArr[2] := 30;
myArr[3] := 40;
myArr[4] := 10;
oDBStats := TList<TDBStats>.Create;
try
for iIndex1 := 0 to 4 do
begin
rDBStats.Comb := myArr[iIndex1];
if oDBStats.Contains(rDBStats) then
Update(oDBStats, rDBStats, oDBStats.IndexOf(rDBStats))
else
Add(oDBStats, rDBStats);
end;
// Check List
for iIndex1 := 0 to Pred(oDBStats.Count) do
Writeln(oDBStats[iIndex1].Comb:3, oDBStats[iIndex1].Freq:10);
finally
oDBStats.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
Readln;
end.
and should return this result:
10 2
20 1
30 1
40 1
50 1
but return this result:
10 1
20 1
30 1
40 1
50 1
10 1
I have understood about problem: when i use oDBStats.Contains(rDBStats) it control if rDBStats element is contained in list; the first time not found it and add in list; but when it is added in list i update freq field to 1; so second time when i check again being rdbstats with freq = 0 not found it.
As i can solve this problem? I need to have a counter, where i get from input a "comb" and i want check if this "comb" is present in list, indipendetely from value of the other field of the record. In case i find "comb" in list, then i update, increasing freq field.
Thanks for help.
When you call Contains on a generic list, it looks if the given value is already inside the list. The value in your case is a record which consists of two fields. As you didn't specify a custom comparer, Delphi will use a default comparer which in case of a record does a binary compare. So only when two records are binary equal they will be treated as equal.
To make your example work you have to specify a custom comparer that compares only the comb field of the records. This is an example:
oDBStats := TList<TDBStats>.Create(TDelegatedComparer<TDBStats>.Create(
function(const Left, Right: TDBStats): Integer
begin
result := CompareValue(Left.comb, Right.comb);
end));
In addition you have an error in your update routine. Instead of incrementing the existing value, you are incrementing the undefined value of the item parameter. The change in the first line should make it work:
rItem := oDBStats[Index];
Inc(rItem.Freq);
oDBStats[Index] := rItem;
You have the wrong data structure since what you really need is a dictionary.
The fundamental problem with using a list is that you want to search on a subset of the stored record. But lists are not set up for that. Solve the problem by re-writing using TDictionary<Integer, Integer>.
I can recommend that you have a thorough read of the dictionary code example at the Embarcadero docwiki.
The key to the dictionary is what you call comb and the value is freq. To add an item you do this:
if Dict.TryGetValue(Comb, Freq) then
Dict[Comb] := Freq+1
else
Dict.Add(Comb, 1);
I'm assuming your dictionary is declared like this:
var
Dict: TDictionary<Integer, Integer>;
and created like this:
Dict := TDictionary<Integer, Integer>;
You can enumerate the dictionary with a simple for in loop.
var
Item: TPair<Integer, Integer>;
...
for Item in Dict do
Writeln(Item.Key:3, Item.Value:10);
Although be warned that the dictionary will enumerate in an odd order. You may wish to sort before printing.
If you wish to store more information associated with each entry in the dictionary then put the additional fields in a record.
type
TDictValue = record
Freq: Integer;
Field1: string;
Field2: TDateTime;
//etc.
end;
Then your dictionary becomes TDictionary<Integer, TDictValue>.