Alright, so you have a TObjectList instance. You want to loop through the items in it and delete some of the objects from the list. You can't do this:
for I := 0 to ObjectList.Count - 1 do
if TMyClass(ObjectList[I]).ShouldRemove then
ObjectList.Delete(I);
...because once you delete the first object the index counter I will be all wrong and the loop won't work any more.
So here is my solution:
Again:
for I := 0 to ObjectList.Count - 1 do
if TMyClass(ObjectList[I]).ShouldRemove then
begin
ObjectList.Delete(I);
goto Again;
end;
This is the best solution I've found to this so far. If anyone has a neater solution I'd love to see it.
Try this instead:
for I := ObjectList.Count - 1 downto 0 do
if TMyClass(ObjectList[I]).ShouldRemove then
ObjectList.Delete(I);
That looks like a particularly bad use of goto, jumping out of the for loop like that. I assume it works (since you're using it), but it would give me the willies.
You can also use
I := 0;
while I < ObjectList.Count do begin
if TMyClass(ObjectList[I]).ShouldRemove then ObjectList.Delete(I)
else Inc(I);
end;
The only valid use of Goto I've seen is the one supplied in Delphi's help.
for I := 0 to something do
begin
for J := 0 to something do
begin
For K := 0 to something do
begin
if SomeCondition then
Goto NestedBreak
end;
end;
end;
NestedBreak:
Though Goto could be avoided in that exemple by moving the loop in a local function and using EXIT, for exemple. If a subfunction is not acceptable, you can still do that:
for I := 0 to something do
begin
for J := 0 to something do
begin
For K := 0 to something do
begin
if SomeCondition then
begin
GottaBreak := True
Break;
end;
end;
if GottaBreak then Break;
end;
if GottaBreak then Break;
end;
This is just sligthly less optimal.
I have yet to see a single other situation where a Goto would be the best solution.(Or any good at all).
Goto in itself is NOT bad. It's a flow control command just like EXIT, BREAK or CONTINUE. Except that those other are restricted to specific situations and are managed by the compiler correctly. (With that being said, some programmer I spoke with consider those as being as harmful as Goto, a view I don't share) Goto being unrestricted, the things you can do with it can have very negative impacts. Anyway, I think I went a bit beyond the scope of the question already. ^_^
Related
I have to check each line of a file against another file.
If one line from the first file exists in the second file I have to delete it.
Right now i'm using 2 listboxes and the "for listbox1.items.count-1 downto do begin..."
My program works but I have to check this for huge files with over 1 milion lines.
Is there a faster approach to this method?
I want to load the files inside memory in order to be extremely fast!
Thanks
You can use TStringList for this. List for second file should be sorted for faster search. Try this:
var
l1, l2: TStringList;
i: integer;
begin
l1 := nil;
l2 := nil;
try
l1 := TStringList.Create;
l1.loadfromFile('file1');
l2 := TStringList.Create;
l2.LoadFromFile('file2');
l2.Sorted := True;
for i := l1.Count -1 downto 0 do
begin
if l2.IndexOf(l1[i]) <> -1 then
l1.Delete(i);
end;
l1.SaveToFile('file1');
finally
FreeEndNil(l1);
FreeEndNil(l2);
end
end
A quick solution (but not the fastest one) is to use two TStringList lists instead of list boxes.
var
a, b: TStringList;
i: Integer;
begin
a := TStringList.Create;
b := TStringList.Create;
try
a.LoadFromFile('C:\1.txt');
b.LoadFromFile('C:\2.txt');
b.Sorted := True;
for i := a.Count - 1 downto 0 do
begin
// Check if line of file 'a' are present in file 'b'
// and delete line if true
if b.IndexOf(a[i]) > -1 then
a.Delete(i);
end;
a.SaveToFile('C:\1.txt');
finally
b.Free;
a.Free;
end;
end;
Again, this is a slow and simple solution that loads whole files in RAM. It still will be much faster than using a ListBox. Sometimes simple is just enough for solving a one-time problem.
A faster method would be to create an index (eg. binary tree) of both files on hard disk and use this index to compare. That way you will not need to store the whole files on disk.
Today I have met very strange bug.
I have the next code:
var i: integer;
...
for i := 0 to FileNames.Count - 1 do
begin
ShowMessage(IntToStr(i) + ' from ' + IntToStr(FileNames.Count - 1));
FileName := FileNames[i];
...
end;
ShowMessage('all');
FileNames list has one element. So, I consider then loop will be executed once and I see
0 from 0
all
It is a thing I did thousands times :).
But in this case I see the second loop iteration when code optimization is switched on.
0 from 0
1 from 0
all
Without code optimization loop iterates right.
For the moment I don't know even the direction to move with this issue (and upper loop bound stays unchanged, yes).
So any suggestion will be very helpful. Thanks.
I use Delphi 2005 (Upd2) compiler.
Considering the QC report referred to by LU RD, and my own experience with D2005, here is a few workarounds. I recall using the while loop solution myself.
1.Rewrite the for loop as a while loop
var
i: integer;
begin
i := 0;
while i < FileNames.Count do
begin
...
inc(i);
end;
end;
2.Leave the for loop control variable alone from any other processing and use a separate variable, that you increment in the loop, for string manipulation and FileNames indexing.
var
ctrl, indx: integer;
begin
indx := 0;
for ctrl := 0 to FileNames.Count-1 do
begin
// use indx for string manipulation and FileNames indx
inc(indx);
end;
end;
3.You hinted at a workaround in saying Without code optimization loop iterates right.
Assuming you have optimization on turn it off ( {$O-} ) before the procedure/function and on ( {$O+} ) again after. Note! The Optimization directive can only be used around at least whole procedures/functions.
Ok, it seems to me I solved the problem and can explain it.
Unfortunately, I cannot make test to reproduce the bug, and I cannot show the real code, which under NDA. So I must use simplified example again.
Problem is in dll, which used in my code. Consider the next data structure:
type
TData = packed record
Count: integer;
end;
TPData = ^TData;
and function, which defined in dll:
Calc: function(Data: TPData): integer; stdcall;
In my code I try to proceed data records which are taken from list (TList):
var
i: integer;
Data: TData;
begin
for i := 0 to List.Count - 1 do
begin
Data := TPData(List[i])^;
Calc(#Data);
end;
and in case when optimization is on I see second iteration in loop from 0 to 0.
If rewrite code as
var
i: integer;
Data, Data2: TData;
begin
for i := 0 to List.Count - 1 do
begin
Data := TPData(List[i])^;
Data2 := TPData(List[i])^;
Calc(#Data2);
end;
all works as expected.
Dll itself was developed by another programmer, so I asked him to take care about it.
What was unexpected for me - that local procedure's stack can be corruped in so unusual way without access violations or other similar errors. BTW, Data and Data2 variables contains correct values.
Maybe, my experience will be useful to someone. Thanks all who helps me and please sorry my unconscious mistakes.
I read that using the Goto command is very bad and can mess up your code. I also read that there was a poll saying that 40% of Delphi developers will be very cross if they see the goto command and delphi together and the other 40% don't even know of the goto command, why is that?
But anyways, I was making a program that checks if you qualify for a bursary by getting the two marks and getting the avarage of those two marks. In order to get the Bursary, you need to have a 90% average or above and it will display your average in a label and if you qualify in another label. I recently also learned about the If command and now I am just busy playing around with it.
Here's my code:
procedure TForm1.btnCalcClick(Sender: TObject);
var
iMaths, iScience, iAvarage : integer;
begin
iScience := sedScience.value;
iMaths := sedMath.value;
iAvarage := round((iMaths+iScience)/2);
if iMaths = 0
then
begin
showmessage ('Sorry, please put a propper value in the Maths and Science box!');
end;
if iAvarage >= 90
then
begin
lblAvarage.caption := 'Your avarage is: ' + IntToStr (iAvarage);
lblOutput.caption := 'You qualify for an Einstein Bursary!';
end
else
begin
lblAvarage.Caption := 'Your avarage is ' + IntToStr (iAvarage);
lblOutput.caption := 'Sorry, you do not qualify for an Einstein bursary.';
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
sedMath.value := 0;
sedScience.value := 0;
lblAvarage.caption := ' ';
lblOutput.caption := ' ';
sedMath.setfocus
end;
end.
Where I say if iMaths = 0 thats just making sure that there is a value in the SpinEdit, if there isn't, it must restart at the ButtonClick handler with a message saying Please insert a proper value. That all works fine, but it still displays the average in the labels (lblOutput and lblAvarage) which I don't want it to do!
If I use the goto command, this is how I think it should look:
procedure TForm1.btnCalcClick(Sender: TObject);
var
iMaths, iScience, iAvarage : integer;
label
lRestart;
begin
lRestart;
iScience := sedScience.value;
iMaths := sedMath.value;
iAvarage := round((iMaths+iScience)/2);
if iMaths and iScience = 0
then
begin
showmessage ('Sorry, please put a propper value in the Maths and Science box!');
goto lRestart;
end;
(BTW, I know the above code it wrong, I tried!)
I googled goto but I find things that are different to what I need.
Any help or advice on how to use the goto command would be greatly appreciated!
Your syntax is not correct for goto. It should be:
procedure TForm1.btnCalcClick(Sender: TObject);
....
label
lRestart;
begin
lRestart:
....
goto lRestart;
....
end;
But if you ever wanted to do something like this you'd surely avoid the goto by writing it thus:
repeat
// do something
until OkToContinue;
That said, your code should be:
procedure TForm1.btnCalcClick(Sender: TObject);
var
iMaths, iScience, iAverage: integer;
begin
iScience := sedScience.value;
iMaths := sedMath.value;
iAverage := round((iMaths+iScience)/2);
if (iMaths=0) or (iScience=0) then
begin
ShowMessage('Sorry, please put a propper value in the Maths and Science box!');
exit;
end;
// do the calculation
end;
There's no need for looping or goto in your event handler. You have to exit when you find an error and give the user opportunity to fix the mistake and click the button again. So it's just a complete mis-think on your part that you would need a goto.
I guess you have not yet fully grasped the concept of event driven programming. Were you to go back to the beginning instead of exiting the procedure, the user would have no opportunity to modify the values of the spin edit controls and you would show the message again and again and again. Try it and see what I mean.
Note also that I fixed a number of other errors in your code.
As for goto, I'm sure that you won't need it ever. I've only ever found goto to be useful in languages that don't support structured exceptions. Delphi does not fall into that camp.
You should not need to use goto in your programs.
Some reasons not to use it, since in most cases:
It will make your code less readable;
It can be easily converted into nested repeat .. until or while .. structures, which are usually with the same exact timing (will be compiled as assembler jmp .. opcode.
Sometimes, it may be slightly faster to put the conditional expression of the repeat .. until or while .. structures within the loop, and use break and continue and repeat .. until false or while true do ..:
function GotoEndOfJSONString(P: PUTF8Char): PUTF8Char;
begin // P^='"' at function call
inc(P);
repeat
if P^=#0 then
break else
if P^<>'\' then
if P^<>'"' then
inc(P) else
break else
inc(P,2);
until false;
result := P;
end; // P^='"' at function return
Which will be compiled with very optimized assembler:
inc eax
#s: mov dl,[eax]
test dl,dl
jz #e
cmp dl,$5c
je #2
cmp dl,$22
je #e
inc eax
jmp #s
#2: add eax,2
jmp #s
#e: ret
But this is perhaps worth it only for very low-level code, and will make it less readable. Writing such code is very close to writing directly the assembler code: you know that the break and continue will be converted into direct jmp .. assembler opcodes.
The only case when I use goto is in some well-defined conditions:
Identified low-level process of data (e.g. text handling);
Only for performance reasons;
With proper unit testing (since code is less readable);
When branching is needed in-between case .. of inner blocks, or from one loop to another;
When I want to avoid calling a sub-procedure in older versions of Delphi (e.g. Delphi 7) - but in modern Delphi, goto can be replaced by an inline local procedure.
Some example:
procedure TTextWriter.AddJSONEscape(P: Pointer; Len: PtrInt);
var c: PtrUInt;
label Esc, nxt;
begin
if P=nil then exit;
if Len=0 then
Len := MaxInt;
if B>=BEnd then
Flush;
repeat
inc(B);
// escape chars, according to http://www.ietf.org/rfc/rfc4627.txt
c := PByte(P)^;
if c>=32 then begin
if c in [ord('\'),{ord('/'),}ord('"')] then goto Esc;
B^ := AnsiChar(c);
nxt: if Len=1 then
break;
dec(Len);
inc(PByte(P));
if B<BEnd then
continue;
Flush;
end else
case c of
0: begin
dec(B); break; end;
8: begin
c := ord('b'); goto Esc; end;
9: begin
c := ord('t'); goto Esc; end;
$a: begin
c := ord('n'); goto Esc; end;
$c: begin
c := ord('f'); goto Esc; end;
$d: begin
c := ord('r');
Esc: B^ := '\';
if B>=BEnd then // inlined: avoid endless loop
Flush;
B[1] := AnsiChar(c);
inc(B);
goto nxt;
end;
else begin // characters below ' ', #7 e.g. -> // 'u0007'
B^ := '\';
AddShort('u00');
Add(HexChars[c shr 4],HexChars[c and $F]);
goto nxt;
end;
end;
until false;
end;
As a conclusion, outside the FastCode challenge in pure pascal or some low-level code, you should not see any goto any more.
what is the fastest way to find duplicates in a Tstringlist. I get the data I need to search for duplicates in a Stringlist. My current idea goes like this :
var TestStringList, DataStringList : TstringList;
for i := 0 to DataStringList.Items-1 do
begin
if TestStringList.Indexof(DataStringList[i])< 0 < 0 then
begin
TestStringList.Add(DataStringList[i])
end
else
begin
memo1.ines.add('duplicate item found');
end;
end;
....
Just for completeness, (and because your code doesn't actually use the duplicate, but just indicates one has been found): Delphi's TStringList has the built-in ability to deal with duplicate entries, in it's Duplicates property. Setting it to dupIgnore will simply discard any duplicates you attempt to add. Note that the destination list has to be sorted, or Duplicates has no effect.
TestStringList.Sorted := True;
TestStringList.Duplicates := dupIgnore;
for i := 0 to DataStringList.Items-1 do
TestStringList.Add(DataStringList[i]);
Memo1.Lines.Add(Format('%d duplicates discarded',
[DataStringList.Count - TestStringList.Count]));
A quick test shows that the entire loop can be removed if you use Sorted and Duplicates:
TestStringList.Sorted := True;
TestStringList.Duplicates := dupIgnore;
TestStringList.AddStrings(DataStringList);
Memo1.Lines.Add(Format('%d duplicates discarded',
[DataStringList.Count - TestStringList.Count]));
See the TStringList.Duplicates documentation for more info.
I think that you are looking for duplicates. If so then you do the following:
Case 1: The string list is ordered
In this scenario, duplicates must appear at adjacent indices. In which case you simply loop from 1 to Count-1 and check whether or not the elements of index i is the same as that at index i-1.
Case 2: The string list is not ordered
In this scenario we need a double for loop. It looks like this:
for i := 0 to List.Count-1 do
for j := i+1 to List.Count-1 do
if List[i]=List[j] then
// duplicate found
There are performance considerations. If the list is ordered the search is O(N). If the list is not ordered the search is O(N2). Clearly the former is preferable. Since a list can be sorted with complexity O(N log N), if performance becomes a factor then it will be advantageous to sort the list before searching for duplicates.
Judging by the use of IndexOf you use an unsorted list. The scaling factor of your algorithm then is n^2. That is slow. You can optimize it as David shown by limiting search area in the internal search and then the average factor would be n^2/2 - but that still scales badly.
Note: scaling factor here makes sense for limited workloads, say dozen or hundreds of strings per list. For larger sets of data asymptotic analysis O(...) measure would suit better. However finding O-measures for QuickSort and for hash-lists is a trivial task.
Option 1: Sort the list. Using quick-sort it would have scaling factor n + n*log(n) or O(n*log(n)) for large loads.
Set Duplicates to accept
Set Sorted to True
Iterate the sorted list and check if the next string exists and is the same
http://docwiki.embarcadero.com/Libraries/XE3/en/System.Classes.TStringList.Duplicates
http://docwiki.embarcadero.com/Libraries/XE3/en/System.Classes.TStringList.Sorted
Option 2: use hashed list helper. In modern Delphi that would be TDictionary<String,Boolean>, in older Delphi there is a class used by TMemIniFile
You iterate your stringlist and then check if the string was already added into the helper collection.
The scaling factor would be a constant for small data chunks and O(1) for large ones - see http://docwiki.embarcadero.com/Libraries/XE2/en/System.Generics.Collections.TDictionary.ContainsKey
If it was not - you add it with "false" value.
If it was - you switch the value to "true"
For older Delphi you can use THashedStringList in a similar pattern (thanks #FreeConsulting)
http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/IniFiles_THashedStringList_IndexOf.html
Unfortunately it is unclear what you want to do with the duplicates. Your else clause suggests you just want to know whether there is one (or more) duplicate(s). Although that could be the end goal, I assume you want more.
Extracting duplicates
The previously given answers delete or count the duplicate items. Here an answer for keeping them.
procedure ExtractDuplicates1(List1, List2: TStringList; Dupes: TStrings);
var
Both: TStringList;
I: Integer;
begin
Both := TStringList.Create;
try
Both.Sorted := True;
Both.Duplicates := dupAccept;
Both.AddStrings(List1);
Both.AddStrings(List2);
for I := 0 to Both.Count - 2 do
if (Both[I] = Both[I + 1]) then
if (Dupes.Count = 0) or (Dupes[Dupes.Count - 1] <> Both[I]) then
Dupes.Add(Both[I]);
finally
Both.Free;
end;
end;
Performance
The following alternatives are tried in order to compare performance of the above routine.
procedure ExtractDuplicates2(List1, List2: TStringList; Dupes: TStrings);
var
Both: TStringList;
I: Integer;
begin
Both := TStringList.Create;
try
Both.AddStrings(List1);
Both.AddStrings(List2);
Both.Sort;
for I := 0 to Both.Count - 2 do
if (Both[I] = Both[I + 1]) then
if (Dupes.Count = 0) or (Dupes[Dupes.Count - 1] <> Both[I]) then
Dupes.Add(Both[I]);
finally
Both.Free;
end;
end;
procedure ExtractDuplicates3(List1, List2, Dupes: TStringList);
var
I: Integer;
begin
Dupes.Sorted := True;
Dupes.Duplicates := dupAccept;
Dupes.AddStrings(List1);
Dupes.AddStrings(List2);
for I := Dupes.Count - 1 downto 1 do
if (Dupes[I] <> Dupes[I - 1]) or (I > 1) and (Dupes[I] = Dupes[I - 2]) then
Dupes.Delete(I);
if (Dupes.Count > 1) and (Dupes[0] <> Dupes[1]) then
Dupes.Delete(0);
while (Dupes.Count > 1) and (Dupes[0] = Dupes[1]) do
Dupes.Delete(0);
end;
Although ExtractDuplicates3 marginally performs better, I prefer ExtractDuplicates1 because it reeds better and the TStrings parameter provides more usability. ExtractDuplicates2 performs noticeable worst, which demonstrates that sorting all items afterwards in a single run takes more time then continuously sorting every single item added.
Note
This answer is part of this recent answer for which I was about to ask the same question: "how to keep duplicates?". I didn't, but if anyone knows or finds a better solution, please comment, add or update this answer.
This is an old thread but I thought this solution may be useful.
An option is to pump the values from one stringlist to another one with the setting of TestStringList.Duplicates := dupError; and then trap the exception.
var TestStringList, DataStringList : TstringList;
TestStringList.Sorted := True;
TestStringList.Duplicates := dupError;
for i := 0 to DataStringList.Items-1 do
begin
try
TestStringList.Add(DataStringList[i])
except
on E : EStringListError do begin
memo1.Lines.Add('duplicate item found');
end;
end;
end;
....
Just note that the trapping of the exception also masks the following errors:
There is not enough memory to expand the list, the list tried to grow beyond its maximal capacity, a non-existent element of the list was referenced. (i.e. the list index was out of bounds).
function TestDuplicates(const dataStrList: TStringList): integer;
begin
with TStringlist.create do begin
{Duplicates:= dupIgnore;}
for it:= 0 to DataStrList.count-1 do begin
if IndexOf(DataStrList[it])< 0 then
Add(DataStrList[it])
else
inc(result)
end;
Free;
end;
end;
:)
First thing, my code
procedure TForm1.Button3Click(Sender: TObject);
var tempId,i:integer;
begin
tempId:=strtoint(edit5.Text);
plik:=TStringList.Create;
plik.LoadFromFile('.\klienci\'+linia_klient[id+1]+'.txt');
if (plik.Count=1) then
begin
label6.Caption:='then';
if (tempId=StrToInt(plik[0])) then
begin
Label6.Caption:='Zwrócono';
plik.Delete(0);
end
end
else
for i:=0 to plik.Count-2 do
begin
if (tempId=StrToInt(plik[i])) then
begin
Label6.Caption:='Zwrócono';
plik.Delete(i);
end;
end;
plik.SaveToFile('.\klienci\'+linia_klient[id+1]+'.txt');
plik.Free;
end;
When for i:=0 to plik.Count-2 do I can delete any element but not
last.
When for i:=0 to plik.Count-1 do I can delete any element without
but from end to start. Because otherwise List index out of bounds.
What's going one? How can I safety search and remove elements from TStringList?
When deleting intems from list you want to use downto loop, ie
for i := plik.Count-1 downto 0 do
begin
if (tempId=StrToInt(plik[i])) then
begin
Label6.Caption:='Zwrócono';
plik.Delete(i);
end;
end;
This ensures that if you delete item, the loop index stays valid as you move from the end of the list dowards beginning of the list.
This is a classic problem. A for loop evaluates the loop bounds once at the beginning of the loop, so you run off the end which explains your index out of bounds errors.
But even if for loops evaluated loop bounds every time like a while does that would not really help. When you delete an element, you reduce the Count by 1 and move the remaining elements down one in the list. So you change the index of all those still to be processed elements.
The standard trick is to loop down the list:
for i := List.Count-1 downto 0 do
if DeleteThisItem(i) then
List.Delete(i);
When you write it this way, the call to Delete affects the indices of elements that have already been processed.
For I := stringlist.count-1 downto 0 do
Now you can delete all items without any error
in an ascending loop like for i:=1 to count you just can't delete items of the list you are iterating over.
there are several solutions depending on the overall logic of what you want to achieve.
you may change the for loop into a while loop that reevaluates count and don't increment index on the delete iteration
you may reverse the loop, kinda for i:=count downto 1
instead of delete, you may create a temporary list and copy there only the items you want to keep, and recopy it back.
As others have said, using a downto loop is usually the best choice. Of course, it does change the semantics of the loop so it runs backwards instead of forwards. If you want to continue looping forwards, you have to use a while loop instead, eg:
I := 0;
while I < plik.Count do
begin
if (tempId = StrToInt(plik[I])) then
begin
...
plik.Delete(I);
end else
Inc(I);
end;
Or:
var
CurIdx, Cnt: Integer;
CurIdx := 0;
Cnt := plik.Count;
for I := 0 to Cnt-1 do
begin
if (tempId = StrToInt(plik[CurIdx])) then
begin
...
plik.Delete(CurIdx);
end else
Inc(CurIdx);
end;