Delphi(2006) Loop Help - delphi

So What I'm essentially trying to do is have something happen 70% of the time, another few things happen 10% of the time each if that makes sense but my app doesn't seem to do any of the actions I'm guessing I'm misunderstanding the loop syntax or something, anyway if anyone could take a look and maybe give me some advice
per1 := 70;
per2 := 77;
per3 := 84;
per4 := 91;
per5 := 100;
per6 := Random(2) + 1;
randomize;
RandPer:= Random(100);
randomize;
RandPer2 := Random(100);
if RandPer2 <= 70 then begin
If RandPer <= per1 then begin
Functiontest(1);
end Else If RandPer <= per2 then begin
Functiontest(3);
end Else begin If RandPer <= per3 then begin
Functiontest(5);
end Else begin If RandPer <= per4 then begin
Functiontest(6);
end Else begin If RandPer <= per5 then begin
Functiontest(9);
end;
end;
end;
end;

You don't have any loop syntax, so that's certainly a possible source of your confusion.
Do not call Randomize multiple times. It reinitializes the random seed each time you do, and that's based on the system clock. If your code runs faster than the clock advances, then your several calls to Randomize will actually reset the random seed to the same value it had before, resulting in repeated Random calls returning the same value.
The help advises you to call Randomize just once at the start of your program. If you are writing a unit or component and you are not in charge of the whole program, then do not call Randomize at all. Instead, document that consumers of your code should call it themselves.
If you are writing a DLL and not using run-time packages, then call Randomize in an initialization function that your DLL exports; consumers of your DLL won't have access to your DLL's copy of the Delphi run-time library.
Also, if you want something to happen 70 percent of the time, then you should check whether your value is strictly less than 70. The possible return values of Random include zero; 70 percent of the results will be between 0 and 69 inclusive. Allowing 70 will actually make the event happen 71 percent of the time.
Finally, your calculations of 10 percent of the time don't make sense to me. You have three events that will happen 7 percent of the time, and one that will happen 9 percent of the time. You can't have four events that each happen 10 percent of the time when you only have 30 percent remaining. Do you mean for each event's frequency to be measured independently of the others? If so, then do not link all your conditional tests together with else; Use completely a separate if statement for each one.

I just modified CharlesF code to do what you need.
Hope CharlesF won't mind.
begin
randomize;
for i := 0 to NumberOfTimesNeed do
begin
R := Random(100);
case R of
0..69 : Functiontest(1); // this will fire 70% of NumberofTimes
70..79 : Funciotntest(2); // 10 percent
80..89 : Funciotntest(3); // 10 percent
90..94 : Funciotntest(4); // 5 percent
// and so on ...
end;
end;

Related

Why does scrolling through ADOTable get slower and slower?

I want to read the entire table from an MS Access file and I'm trying to do it as fast as possible. When testing a big sample I found that the loop counter increases faster when it's reading the top records comparing to last records of the table. Here's a sample code that demonstrates this:
procedure TForm1.Button1Click(Sender: TObject);
const
MaxRecords = 40000;
Step = 5000;
var
I, J: Integer;
Table: TADOTable;
T: Cardinal;
Ts: TCardinalDynArray;
begin
Table := TADOTable.Create(nil);
Table.ConnectionString :=
'Provider=Microsoft.ACE.OLEDB.12.0;'+
'Data Source=BigMDB.accdb;'+
'Mode=Read|Share Deny Read|Share Deny Write;'+
'Persist Security Info=False';
Table.TableName := 'Table1';
Table.Open;
J := 0;
SetLength(Ts, MaxRecords div Step);
T := GetTickCount;
for I := 1 to MaxRecords do
begin
Table.Next;
if ((I mod Step) = 0) then
begin
T := GetTickCount - T;
Ts[J] := T;
Inc(J);
T := GetTickCount;
end;
end;
Table.Free;
// Chart1.SeriesList[0].Clear;
// for I := 0 to Length(Ts) - 1 do
// begin
// Chart1.SeriesList[0].Add(Ts[I]/1000, Format(
// 'Records: %s %d-%d %s Duration:%f s',
// [#13, I * Step, (I + 1)*Step, #13, Ts[I]/1000]));
// end;
end;
And the result on my PC:
The table has two string fields, one double and one integer. It has no primary key nor index field. Why does it happen and how can I prevent it?
I can reproduce your results using an AdoQuery with an MS Sql Server dataset of similar size to yours.
However, after doing a bit of line-profiling, I think I've found the answer to this, and it's slightly counter-intuitive. I'm sure everyone who does
DB programming in Delphi is used to the idea that looping through a dataset tends to be much quicker if you surround the loop by calls to Disable/EnableControls. But who would bother to do that if there are no db-aware controls attached to the dataset?
Well, it turns out that in your situation, even though there are no DB-aware controls, the speed increases hugely if you use Disable/EnableControls regardless.
The reason is that TCustomADODataSet.InternalGetRecord in AdoDB.Pas contains this:
if ControlsDisabled then
RecordNumber := -2 else
RecordNumber := Recordset.AbsolutePosition;
and according to my line profiler, the while not AdoQuery1.Eof do AdoQuery1.Next loop spends 98.8% of its time executing the assignment
RecordNumber := Recordset.AbsolutePosition;
! The calculation of Recordset.AbsolutePosition is hidden, of course, on the "wrong side" of the Recordset interface, but the fact that the time to call it apparently increases the further you go into the recordset makes it reasonable imo to speculate that it's calculated by counting from the start of the recordset's data.
Of course, ControlsDisabled returns true if DisableControls has been called and not undone by a call to EnableControls. So, retest with the loop surrounded by Disable/EnableControls and hopefully you'll get a similar result to mine. It looks like you were right that the slowdown isn't related to memory allocations.
Using the following code:
procedure TForm1.btnLoopClick(Sender: TObject);
var
I: Integer;
T: Integer;
Step : Integer;
begin
Memo1.Lines.BeginUpdate;
I := 0;
Step := 4000;
if cbDisableControls.Checked then
AdoQuery1.DisableControls;
T := GetTickCount;
{.$define UseRecordSet}
{$ifdef UseRecordSet}
while not AdoQuery1.Recordset.Eof do begin
AdoQuery1.Recordset.MoveNext;
Inc(I);
if I mod Step = 0 then begin
T := GetTickCount - T;
Memo1.Lines.Add(IntToStr(I) + ':' + IntToStr(T));
T := GetTickCount;
end;
end;
{$else}
while not AdoQuery1.Eof do begin
AdoQuery1.Next;
Inc(I);
if I mod Step = 0 then begin
T := GetTickCount - T;
Memo1.Lines.Add(IntToStr(I) + ':' + IntToStr(T));
T := GetTickCount;
end;
end;
{$endif}
if cbDisableControls.Checked then
AdoQuery1.EnableControls;
Memo1.Lines.EndUpdate;
end;
I get the following results (with DisableControls not called except where noted):
Using CursorLocation = clUseClient
AdoQuery.Next AdoQuery.RecordSet AdoQuery.Next
.MoveNext + DisableControls
4000:157 4000:16 4000:15
8000:453 8000:16 8000:15
12000:687 12000:0 12000:32
16000:969 16000:15 16000:31
20000:1250 20000:16 20000:31
24000:1500 24000:0 24000:16
28000:1703 28000:15 28000:31
32000:1891 32000:16 32000:31
36000:2187 36000:16 36000:16
40000:2438 40000:0 40000:15
44000:2703 44000:15 44000:31
48000:3203 48000:16 48000:32
=======================================
Using CursorLocation = clUseServer
AdoQuery.Next AdoQuery.RecordSet AdoQuery.Next
.MoveNext + DisableControls
4000:1031 4000:454 4000:563
8000:1016 8000:468 8000:562
12000:1047 12000:469 12000:500
16000:1234 16000:484 16000:532
20000:1047 20000:454 20000:546
24000:1063 24000:484 24000:547
28000:984 28000:531 28000:563
32000:906 32000:485 32000:500
36000:1016 36000:531 36000:578
40000:1000 40000:547 40000:500
44000:968 44000:406 44000:562
48000:1016 48000:375 48000:547
Calling AdoQuery1.Recordset.MoveNext calls directly into the MDac/ADO layer, of
course, whereas AdoQuery1.Next involves all the overhead of the standard TDataSet
model. As Serge Kraikov said, changing the CursorLocation certainly makes a difference and doesn't exhibit the slowdown we noticed, though obviously it's significantly slower than using clUseClient and calling DisableControls. I suppose it depends on exactly what you're trying to do whether you can take advantage of the extra speed of using clUseClient with RecordSet.MoveNext.
When you open a table, ADO dataset internally creates special data structures to navigate dataset forward/backward - "dataset CURSOR". During navigation, ADO stores the list of already visited records to provide bidirectional navigation.
Seems ADO cursor code uses quadratic-time O(n2) algorithm to store this list.
But there are workaround - use server-side cursor:
Table.CursorLocation := clUseServer;
I tested your code using this fix and get linear fetch time - fetching every next chunk of records takes the same time as previous.
PS Some other data access libraries provides special "unidirectional" datasets - this datasets can traverse only forward and don't even store already traversed records - you get constant memory consumption and linear fetch time.
DAO is native to Access and (IMHO) is typically faster.
Whether or not you switch, use the GetRows method. Both DAO and ADO support it.
There is no looping. You can dump the entire recordset into an array with a couple of lines of code. Air code:
yourrecordset.MoveLast
yourrecordset.MoveFirst
yourarray = yourrecordset.GetRows(yourrecordset.RecordCount)

Delphi - Calculate Minimum Maximum and Average in items in a list

I am building a single application to Calculate Min Max and Avg of Values in a List.
It is actually Temperatures. So I think I am Almost correct but there are 2 Errors.
var
Count, Average, Sum,i, Max, Min, K : Integer;
Temperatures : Array of Integer;
NoItems : Double;
begin
Count := 0;
Sum := 0;
Max := 0;
Min := 0;
Average := 0;
Count := lstTemp.Items.Count;
{Calculate Sum of Values in the list}
for i := 0 to Count - 1 do
Sum := Sum + StrToInt(lstTemp.Items[i]);
{Calculate Min and Max}
SetLength(Temperatures,Count);
for K:=0 to Count-1 do
Temperatures[K] := lstTemp.Items[K];
if (Temperatures[K] > Max) then
Max := Temperatures[K];
if (Temperatures[K] < Min) then
Min := Temperatures[K];
{Calculate Average}
Average := Sum / Count;
edtAvg.Text:=IntToStr(Average); //Display Average
edtAvg.Text:=IntToStr(Min); //Display Minimum Temp.
edtAvg.Text:=IntToStr(Max); //Display Maximum Temp.
end;
So the 2 Errors are
Error: Incompatible types: got "AnsiString" expected "LongInt"
This is for Average := Sum / Count;
Error: Incompatible types: got "Set Of Byte" expected "Double"
This Error is for Temperatures[K] := lstTemp.Items[K];
Any Ideas how to solve this?
Sum and Count are both Integers so I dont know why it shouldnt work!
Thanks
There is a number of problems. First, when you write
for K:=0 to Count-1 do
Temperatures[K] := lstTemp.Items[K];
if (Temperatures[K] > Max) then
Max := Temperatures[K];
if (Temperatures[K] < Min) then
Min := Temperatures[K];
you actually do
for K:=0 to Count-1 do
Temperatures[K] := lstTemp.Items[K];
if (Temperatures[K] > Max) then
Max := Temperatures[K];
if (Temperatures[K] < Min) then
Min := Temperatures[K];
which is nonsense. You want all these lines to be part of the for loop:
for K:=0 to Count-1 do
begin
Temperatures[K] := lstTemp.Items[K];
if (Temperatures[K] > Max) then
Max := Temperatures[K];
if (Temperatures[K] < Min) then
Min := Temperatures[K];
end;
Second, in order for this algorithm to work, the initial value of Min (Max) needs to be larger (smaller) than the values in the list. This might work for Max := 0, but probably not for Min := 0. You need to set Min to a very large value before you run the loop, obviously. The best value you can use is the highest-possible signed 32-bit integer value, that is, 2^31 - 1, which is the value of the MaxInt constant.
Third,
Temperatures[K] := lstTemp.Items[K];
is probably wrong. Temperatures is an array of integers, while lstTemp.Items[K] is a string (at least according to StrToInt(lstTemp.Items[i])), so you need
Temperatures[K] := StrToInt(lstTemp.Items[K]);
Fourth, you declare Average as an integer, but it needs to be a floating-point number (obviously), like real or double.
Fifth,
edtAvg.Text:=IntToStr(Average); //Display Average
edtAvg.Text:=IntToStr(Min); //Display Minimum Temp.
edtAvg.Text:=IntToStr(Max); //Display Maximum Temp.
is not techncally incorrect, but will most likely not do what you want.
Sixth, although not an error, there is no need for you to initialise Count and Average to 0. Finally, you only need a single for loop.
There is (at least in Delphi 2010 - unit Math) one function that will calculate the mean and standard deviation in one step and functions that return the minimum and maximum values in an array. BTW, Mean is the arithmetic average of all the values and is the correct term. (I copied an example that I am working on and modified to your example - it compiles at least):
type
a = array of double;
var
Temperatures : a;
Average,stddev3, Max, Min : extended;
// Compiler insists on extended for these properties
begin
Max := Math.MaxValue(Temperatures);
Min := Math.MinValue(Temperatures);
Math.MeanAndStdDev(Temperatures ,Average,stddev3);
end;
For the maximum value in an array use (it takes an array of double and returns double):
function MaxValue(const Data: array of Double): Double;
For the minimum value use the corresponding:
function MinValue(const Data: array of Double): Double;
I agree that average cannot be an integer, but there are 2 similar functions for integer arrays:
function MinIntValue(const Data: array of Integer): Integer; and
function MaxIntValue(const Data: array of Integer): Integer;
0909EM's reply was very well done, but I have a few disagreements. First, I don't believe there's a need to set any sentinel value at all; simply use the first temperature value. Second, if we put a Begin and End around every single line If statement we'd approach COBOL-like levels of English verbosity. As it is, it's a crying shame this simple problem takes so much code. Third, I would not use StrToIntDef. Remember these lines from the Zen Of Python (I don't care if you don't know Python; everyone should memorize it, at least until we get an I Ching of Intersimone):
Errors should never pass silently.
Unless explicitly silenced.
If a user passes incorrect data into the temperature stats procedure, StrToIntDef is going to silently convert these values to zeroes, an unexpected and undesired behavior. The caller is going to get back answers that they assume are ok (because of no errors), yet will have incorrect values (especially the average). It is a far better thing to let the procedure blow up so testing will reveal the incorrect input.
I'd also replace the For loops with For...in. I banged this together:
program temps;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes, Generics.Collections, Math;
Var
someTemps : TStringList;
Procedure TempStats(temperatures : TStringList);
Var
temps : TList<Real>;
minTemp, maxTemp, sumTemps : Real;
numTemps : Integer;
tempStr : String;
temp : Real;
avgTemp : Real;
Begin
numTemps := temperatures.Count;
If numTemps > 0 then
Begin
temps := TList<Real>.Create;
For tempStr in temperatures Do
temps.Add(StrToFloat(tempStr));
minTemp := temps[0];
maxTemp := temps[0];
sumTemps := 0;
For temp in temps Do
Begin
minTemp := Min(minTemp, temp);
maxTemp := Max(maxTemp, temp);
sumTemps := sumTemps + temp;
End;
avgTemp := sumTemps / numTemps;
WriteLn(avgTemp:0:2);
WriteLn(minTemp:0:2);
WriteLn(maxTemp:0:2);
temps.Free;
End
Else
WriteLn('No temperatures passed.');
End;
Begin
someTemps := TStringList.Create;
someTemps.AddStrings(TArray<String>.Create('72', '93', '84', '76', '82'));
TempStats(someTemps);
ReadLn;
someTemps.Clear;
TempStats(someTemps);
someTemps.Free;
ReadLn;
end.
Firstly, Consider using StrToIntDef (String To Integer with a Default value) instead of StrToInt (String to Integer) this will yield the following...
value := StrToIntDef('Abcdef', 0); // value will be zero
vs
value := StrToInt('Abcdef'); // exception
But the question is do you want integers or floating point values for your temperatures? (eg 1 or 1.6?) If you want floating point values, maybe use StrToFloatDef...
Second, I've seen lots of grads that use Delphi make this mistake, try to always use begin and end, it'll help... because it makes it really clear what you are doing inside a if/for/while and what you intend to do outside..
for i := 0 to lstTemp.Items.Count - 1 do
begin
// Sum all the items in the list
Sum := Sum + StrToIntDef(lstTemp.Items[i], 0);
end;
Next up your array is a bit pointless, the SetLength and adding items bit is OK, but its not very functional, when you could just use the items in the list. All you need to do is hang onto the max and min values.
Then your last problem is that Average isn't going to be a whole integer, its going to have a fractional part. Eg. 5 divided by 2 is 2.5, not 2 and not 3. You could use trunc to return just the integer part, or change Average so that its a floating point number...
for K:=0 to lstTemp.Items.Count-1 do
begin
if (StrToIntDef(lstTemp.Items[K], 0) > Max) then
begin
Max := StrToIntDef(lstTemp.Items[K], 0);
end;
if (StrToIntDef(lstTemp.Items[K], 1000) < Min) then // note, really high number
begin
Min := StrToIntDef(lstTemp.Items[K], 1000);
end;
end;
{Calculate Average}
Average := Trunc(Sum / Count); // do you really want to trunc this? I suspect not.
if Min = 1000 then // just incase
begin
Min := 0;
end;
The final problem you will face is that your always setting the text of the same text box...
edtAvg.Text:=IntToStr(Average); //Display Average
edtMin.Text:=IntToStr(Min); //Display Minimum Temp. (I assume this is supposed to be edtMin)
edtMax.Text:=IntToStr(Max); //Display Maximum Temp. (I assume this is supposed to be edtMax)
I suppose the final improvement I'd make is noticing that you only need one for loop...
for K:=0 to lstTemp.Items.Count-1 do
begin
// Sum all the items in the list
Sum := Sum + StrToIntDef(lstTemp.Items[K], 0);
if (StrToIntDef(lstTemp.Items[K], Low(Integer)) > Max) then // A really low value
begin
Max := StrToIntDef(lstTemp.Items[K], Low(Integer));
end;
if (StrToIntDef(lstTemp.Items[K], High(Integer)) < Min) then // A really high value
begin
Min := StrToIntDef(lstTemp.Items[K], High(Integer));
end;
end;
The most important idea on how to solve this is to read your error messages properly. On a previous question you commented: "the error was saying it is an overloaded function or something". That attitude is not going to help you understand the problem. You need to read the error messages properly.
In this question you give the following description of your errors:
So the 2 Errors are Error: Incompatible types: got "AnsiString" expected "LongInt" This is for Average := Sum / Count; Error: Incompatible types: got "Set Of Byte" expected "Double" This Error is for Temperatures[K] := lstTemp.Items[K];
However, the description does not correspond to the errors you should be seeing based on the code provided.
It looks like you didn't read your errors, and just blindly started making changes in the hopes you would accidentally do something right. Because you didn't read the errors, you didn't notice that they changed. So when you came to us looking for help, you provided old errors with new code or vice-versa.
If you had actually read your error messages properly, you might have been able to solve the problem yourself. At the least, you would have been able to ask a better question with a description that actually matched the code.
Average := Sum / Count;
Average, Sum and Count are all declared as Integer. The error message you should be getting is: "Incompatible types: Integer and Extended".
If you read the error message, it should give you a clue to read up on Integer and Extended.
The problem here is that, in maths, division produces a Rational number. And correspondingly the result of a division operation in a program is not an Integer. So you need to declare Average as either Double or Extended.
Temperatures[K] := lstTemp.Items[K];
Temperatures is declared as an array of Integer. You haven't shown the declaration of lstTemp, but based on other code it's one of the standard Delphi Controls that has Items declared as TStrings. So the error message you should be getting is: "Incompatible types: Integer and string".
If you read the error message, it should give you a clue to do the same thing you did 5 lines earlier.
The reason for this error is that Delphi is a "strongly typed" language. The compiler tries to prevent you from making certain kinds of mistakes because it is much better catch them early. Imagine what might happen if one of the values in lstTemp were 'Hello'. That cannot be converted to an Integer; and would cause a "run-time" error in your program.
To fix this problem you need to tell the compiler: "I know the value is a string and could be any string, but I want you to convert it to an Integer". You do this by calling the StrToInt function. NOTE: You will still get a run time error if an invalid string is passed to the function, but by being forced to explicitly do the conversion, you can think about whether you want to do some pre-validation of your input data.
You asked about the errors reported by the compiler. That's just one kind of error you'll face when programming - and usually the easiest to resolve. You'll also encounter logic errors: where your program compiles successfully, but doesn't behave correctly. Andreas's excellent answer has covered those already, so I'll not repeat them.
However, I will give you some valuable advice. Once you've gotten over the hurdle of resolving compiler errors, and are able to do so easily - you need to as quickly as possible:
Get into the habit of testing your code thoroughly.
Learn how to use the integrated debugger.
Learn about its limitations.
Learn other debugging techniques: logging, profiling, pre- and post-condition checking.
Finally, as a response to alcalde's rant about there not being any simple functions to get Min, Max, Sum or Avg: I offer another possible implementation.
Basically the rant was about the fact that he'd far rather write something along the lines of:
begin
if (lstTemp.Count > 0) then
begin
edtMin.Text := lstTemp.Min;
edtMax.Text := lstTemp.Max;
edtAvg.Text := lstTemp.Average;
end
else
begin
ShowMessage('List is empty');
end;
end;
Obviously the above code won't compile, but with a little work we can achieve something similar.
He's perfectly right on two counts: (1) that this implementation would be cleaner, much easier to maintain and with less chance of errors. (2) Delphi doesn't provide a way to simply do that.
In fact, if you follow a top-down design approach, this might be your initial pseudo-code. You should be taught about top-down design, if not demand your money back. :)
The whole point behind the top-down-design approach is that you're looking for an ideal implementation. You're not worrying about what is/isn't there. If the current library and tools don't provide a Min function, you can write your own.
You are a programmer, you have the power!
I sometimes like to call this "wishful thinking programming". You're wishing if other things were in place, I could implement the functionality much more easily like "this". Then you go about making your wish come true.
Without further ado, here's the implementation. You will need to use the Math unit.
type
{ We will call existing functions that take TDoubleArray as input }
TDoubleArray = array of Double;
TStringsHelper = class(TStrings)
{ A useful class to help us convert TStrings into TDoubleArray }
public
class function Using(AStrings: TStrings): TStringsHelper;
function AsDoubleArray: TDoubleArray;
end;
{ TStringsHelper }
function TStringsHelper.AsDoubleArray: TDoubleArray;
var
LoopI: Integer;
begin
SetLength(Result, Count);
for LoopI := 0 to Count - 1 do
begin
Result[LoopI] := StrToFloat(Strings[LoopI]);
end;
end;
class function TStringsHelper.Using(AStrings: TStrings): TStringsHelper;
begin
Result := TStringsHelper(AStrings);
end;
var
LTemperatures: TDoubleArray;
begin
{ This code is almost the same as our "ideal" implementation }
if (lstTemp.Items.Count > 0) then
begin
LTemperatures := TStringsHelper.Using(lstTemp.Items).AsDoubleArray;
edtMin.Text := FloatToStr(MinValue(LTemperatures));
edtMin.Text := FloatToStr(MaxValue(LTemperatures));
edtMin.Text := FloatToStr(Mean(LTemperatures));
end
else
begin
ShowMessage('List is empty');
end;
end;
What values are in lstTemp.Items[i]?
I suppose the values are integers (without floating points), because you are using IntToStr.
Average cannot be an integer. Integer is a number (4 bytes) without a floating point. A simple numbers, such as 2,3,50,1500, -100
Assume that Sum = 100, and the Count = 3.
What Average will be?
So, you have to use float variable type, Double for example.
I hope it helps...

Delphi: Problems with TList of Frames

I'm having a problem with an interface that consists of a number of frames (normally 25) within a TScrollBox.
There are 2 problems, and I am hoping that one is a consequence of the other...
Background:
When the application starts up, I create 25 frames, each containing approx. 20 controls, which are then populated with the default information. The user can then click on a control to limit the search to a subset of information at which point I free and recreate my frames (as the search may return < 25 records)
The problem:
If I quit the application after the initial search then it takes approx. 5 seconds to return to Delphi. After the 2nd search (and dispose / recreate of frames) it takes approx. 20 seconds)
Whilst I could rewrite the application to only create the frames once, I would like to understand what is going on.
Here is my create routine:
procedure TMF.CreateFrame(i: Integer; var FrameBottom: Integer);
var
NewFrame: TSF;
begin
NewFrame := TSF.Create(Self);
NewFrame.Name := 'SF' + IntToStr(i);
if i = 0 then
NewSF.Top := 8
else
NewSF.Top := FrameBottom + 8;
FrameBottom := NewFrame.Top + NewFrame.Height;
NewFrame.Parent := ScrollBox1;
FrameList.Add(NewFrame);
end;
And here is my delete routine:
procedure TMF.ClearFrames;
var
i: Integer;
SF: TSF;
begin
for i := 0 to MF.FrameList.Count -1 do
begin
SF := FrameList[i];
SF.Free;
end;
FrameList.Clear;
end;
What am I missing?
As you are taking control over the memory allocation of the Frames you are creating by Free'ing them, so there's no need to provide Self as the owner parameter in the create constructor. Pass nil instead to prevent the owner trying to free the frame.
Also, don't like the look of your ClearFrames routine. Try this instead:
while FrameList.count > 0 do
begin
TSF(Framelist[0]).free;
Framelist.delete(0);
end;
Framelist.clear;
If you want to know why your app is taking so long to do something, try profiling it. Try running Sampling Profiler against your program. The helpfile explains how to limit the profiling to only a specific section of your app, which you could use to only get sampling results on the clearing or creating parts. This should show you where you're actually spending most of your time and take a lot of the guesswork out of it.

Really fast function to compare the name (full path) of two files

I have to check if I have duplicate paths in a FileListBox (FileListBox has the role of some kind of job list or play list).
Using Delphi's SameText, CompareStr, CompareText, takes 6 seconds. So I came with my own compare function which is (just) a bit faster but not fast enough. Any ideas how to improve it?
function SameFile(CONST Path1, Path2: string): Boolean;
VAR i: Integer;
begin
Result:= Length(Path1)= Length(Path2); { if they have different lenghts then obviously are not the same file }
if Result then
for i:= Length(Path1) downto 1 DO { start from the end because it is more likely to find the difference there }
if Path1[i]<> Path2[i] then
begin
Result:= FALSE;
Break;
end;
end;
I use it like this:
for x:= JList.Count-1 downto 1 DO
begin
sMaster:= JList.Items[x];
for y:= x-1 downto 0 DO
if SameFile(sMaster, JList.Items[y]) then
begin
JList.Items.Delete (x); { REMOVE DUPLICATES }
Break;
end;
end;
Note: The chance of having duplicates is small so Delete is not called often. Also the list cannot be sorted because the items are added by user and sometimes the order may be important.
Update:
The thing is that I lose the asvantage of my code because it is Pascal.
It would be nice if the comparison loop ( Path1[i]<> Path2[i] ) would be optimized to use Borland's ASM code.
Delphi 7, Win XP 32 bit, Tests were done with 577 items in the list. Deleting the items from list IS NOT A PROBLEM because it happens rarely.
CONCLUSION
As Svein Bringsli pointed, my code is slow not because of the comparing algorithm but because of TListBox. The BEST solution was provided by Marcelo Cantos. Thanks a lot Marcelo.
I accepted Svein's answer because it answers directly my question "how to make my comparison function faster" with "there is no point to make it faster".
For the moment I implemented the dirty and quick to implement solution: when I have under 200 files, I use my slow code to check the duplicates. If there are more than 200 files I use dwrbudr's solution (which is damn fast) considering that if the user has so many files, the order is irrelevant anyway (human brain cannot track so many items).
I want to thank you all for ideas and especially Svein for revealing the truth: (Borland's) visual controls are damn slow!
Don't waste time optimising the assembler. You can go from O(n2) to O(n log(n)) — bringing the time down to milliseconds — by sorting the list and then doing a linear scan for duplicates.
While you're at it, forget the SameFile function. The algorithmic improvement will dwarf anything you can achieve there.
Edit: Based on feedback in the comments...
You can perform an order-preserving O(n log(n)) de-duplication as follows:
Sort a copy of the list.
Identify and copy duplicated entries to a third list along with their duplication count minus one.
Walk the original list backwards as per your original version.
In the inner (for y := ...) loop, traverse the duplication list instead. If an outer item matches, delete it, decrement the duplication count, and delete the duplication entry if the count reaches zero.
This is obviously more complicated but it will still be orders of magnitude faster, even if you do horrible dirty things like storing duplication counts as strings, C:\path1\file1=2, and using code like:
y := dupes.IndexOfName(sMaster);
if y <> -1 then
begin
JList.Items.Delete(x);
c := StrToInt(dupes.ValueFromIndex(y));
if c > 1 then
dupes.Values[sMaster] = IntToStr(c - 1);
else
dupes.Delete(y);
end;
Side note: A binary chop would be more efficient than the for y := ... loop, but given that duplicates are rare, the difference ought to be negligible.
Using your code as a starting point, I modified it to take a copy of the list before searching for duplicates. The time went from 5,5 seconds to about 0,5 seconds.
vSL := TStringList.Create;
try
vSL.Assign(jList.Items);
vSL.Sorted := true;
for x:= vSL.Count-1 downto 1 DO
begin
sMaster:= vSL[x];
for y:= x-1 downto 0 DO
if SameFile(sMaster, vSL[y]) then
begin
vSL.Delete (x); { REMOVE DUPLICATES }
jList.Items.Delete (x);
Break;
end;
end;
finally
vSL.Free;
end;
Obviously, this is not a good way to do it, but it demonstrates that TFileListBox is in itself quite slow. I don't believe you can gain much by optimizing your compare-function.
To demonstrate this, I replaced your SameFile function with the following, but kept the rest of your code:
function SameFile(CONST Path1, Path2: string): Boolean;
VAR i: Integer;
begin
Result := false; //Pretty darn fast code!!!
end;
The time went from 5,6 seconds to 5,5 seconds. I don't think there's much more to gain there :-)
Create another sorted list with sortedList.Duplicates := dupIgnore and add your strings to that list, then back.
vSL := TStringList.Create;
try
vSL.Sorted := true;
vSL.Duplicates := dupIgnore;
for x:= 0 to jList.Count - 1 do
vSL.Add(jList[x]);
jList.Clear;
for x:= 0 to vSL.Count - 1 do
jList.Add(vSL[x]);
finally
vSL.Free;
end;
The absolute fastest way, bar none (as alluded to before) is to use a routine that generates a unique 64/128/256 bit hash code for a string (I use the SHA256Managed class in C#). Run down the list of strings, generate the hash code for the strings, check for it in the sorted hash code list, and if found then the string is a duplicate. Otherwise add the hash code to the sorted hash code list.
This will work for strings, file names, images (you can get the unique hash code for an image), etc, and I guarantee that this will be as fast or faster than any other impementation.
PS You can use a string list for the hash codes by representing the hash codes as strings. I've used a hex representation in the past (256 bits -> 64 characters) but in theory you can do it any way you like.
4 seconds for how many calls? Great performance if you call it a billion times...
Anyway, does Length(Path1) get evaluated every time through the loop? If so, store that in an Integer variable prior to looping.
Pointers may yield some speed over the strings.
Try in-lining the function with:
function SameFile(blah blah): Boolean; Inline;
That will save some time, if this is being called thousands of times per second. I would start with that and see if it saves anything.
EDIT: I didn't realize that your list wasn't sorted. Obviously, you should do that first! Then you don't have to compare against every other item in the list - just the prior or next one.
I use a modified Ternary Search Tree (TST) to dedupe lists. You simply load the items into the tree, using the whole string as the key, and on each item you can get back an indication if the key is already there (and delete your visible entry). Then you throw away the tree. Our TST load function can typically load 100000 80-byte items in well under a second. And it could not take any more than this to repaint your list, with proper use of begin- and end-update. The TST is memory-hungry, but not so that you would notice it at all if you only have of the order of 500 items. And much simpler than sorting, comparisons and assembler (if you have a suitable TST implementation, of course).
No need to use a hash table, a single sorted list gives me a result of 10 milliseconds, that's 0.01 seconds, which is about 500 times faster! Here is my test code using a TListBox:
procedure TForm1.Button1Click(Sender: TObject);
var
lIndex1: Integer;
lString: string;
lIndex2: Integer;
lStrings: TStringList;
lCount: Integer;
lItems: TStrings;
begin
ListBox1.Clear;
for lIndex1 := 1 to 577 do begin
lString := '';
for lIndex2 := 1 to 100 do
if (lIndex2 mod 6) = 0 then
lString := lString + Chr(Ord('a') + Random(2))
else
lString := lString + 'a';
ListBox1.Items.Add(lString);
end;
CsiGlobals.AddLogMsg('Start', 'Test', llBrief);
lStrings := TStringList.Create;
try
lStrings.Sorted := True;
lCount := 0;
lItems := ListBox1.Items;
with lItems do begin
BeginUpdate;
try
for lIndex1 := Count - 1 downto 0 do begin
lStrings.Add(Strings[lIndex1]);
if lStrings.Count = lCount then
Delete(lIndex1)
else
Inc(lCount);
end;
finally
EndUpdate;
end;
end;
finally
lStrings.Free;
end;
CsiGlobals.AddLogMsg('Stop', 'Test', llBrief);
end;
I'd also like to point out that your solution would take an extreme amount of time if applied to a huge list (like containing 100,000,000 items or more). Even constructing a hashtable or sorted list would take too much time.
In cases like that you could try another approach : Hash each member, but instead of populating a full-blown hashtable, create a bitset (large enough to contain a close factor to as many slots as there are input items) and just set each bit at the offset indicated by the hashfunction. If the bit was 0, change it to 1. If it was already 1, take note of the offending string-index in a separate list and continue. This results in a list of string-indexes that had a collision in the hash, so you'll have to run it a second time to find the first cause of those collisions. After that, you should sort & de-dupe the string-indexes in this list (as all indexes apart from the first one will be present twice). Once that's done you should sort the list again, but this time sort it on the string-contents in order to easily spot duplicates in a following single scan.
Granted it could be a bit extreme to go this all this length, but at least it's a workable solution for very large volumes! (Oh, and this still won't work if the number of duplicates is very high, when the hash-function has a bad spread or when the number of slots in the 'hashtable' bitset is chosen too small - which would give many collisions which aren't really duplicates.)

delphi app freezes whole win7 system

i have a simple program that sorts a text file according to length of words per line
this program works without problems in my xp based old machine
now i run this program on my new win7/intel core i5 machine, it freezes whole system and back normal after it finishes it's work.
i'v invastigated the code and found the line causing the freeze
it was this specific line...
caption := IntToStr(i) + '..' + IntTostr(ii);
i'v changed it to
caption := IntTostr(ii); //slow rate change
and there is no freeze
and then i'v changed it to
caption := IntTostr(i); //fast rate change
and it freeze again
my procedure code is
var tword : widestring;
i,ii,li : integer;
begin
tntlistbox1.items.LoadFromFile('d:\new folder\ch.txt');
tntlistbox2.items.LoadFromFile('d:\new folder\uy.txt');
For ii := 15 Downto 1 Do //slow change
Begin
For I := 0 To TntListBox1.items.Count - 1 Do //very fast change
Begin
caption := IntToStr(i) + '..' + IntTostr(ii); //problemetic line
tword := TntListBox1.items[i];
LI := Length(tword);
If lI = ii Then
Begin
tntlistbox3.items.Add(Trim(tntlistbox1.Items[i]));
tntlistbox4.items.Add(Trim(tntlistbox2.Items[i]));
End;
End;
End;
end;
any idea why ? and how to fix it?
i use delphi 2007/win32
Is this happening inside an event handler on a form? I'm going to guess taht it is. In that case, "Caption" is in the scope of the form. The form's caption text isn't managed by the VCL, but by Windows, and if you're sending a new WM_SETTEXT message on every iteration of the loop.
A thorough explanation of why this is doing what it's doing would require knowledge of Windows internals that I don't have, but if I were to take a guess, I'd say it's something like this:
Every time you send that WM_SETTEXT message with a new caption, Windows checks to make sure it's not identical to the existing caption. If it is, it can exit immediately. That's why the infrequent change (the one that only uses ii) doesn't slow your system down. But if it does change on every iteration, then Windows has to perform some sort of task switch in order to change it.
As for why that would bog down the entire system under a Vista kernel (including Win7) but not XP, that's completely outside my area of expertise. But if you're trying to do this as some sort of progress indicator, there are better ways, especially if this loop is as tight as it looks.
The best way to handle progress updates in a tight loop is to count iterations and only fire once every X times. (100 or 1000 can be good values for X, depending on how many times it's running and how fast the whole thing takes.) This is basically what the ii only option does. You could also try putting a Progress Bar on the form to measure progress instead of doing it through the form's caption.
Changing a Form's caption releases a whole bunch of actions - especially under Vista and Win7 with Aero active.
A quick try would be using a TLabel instead for displaying progress. Something like
Label1.caption := IntToStr(i) + '..' + IntTostr(ii); //problemetic line
Label1.Refresh; // or Repaint
should do the trick unless your label is transparent or on a glass area.
It would probably be best to follow Mason Wheeler's advice and use a progressbar. As the overall number of iterations is 15*TntListBox1.items.Count you can calculate the progress value quite easily.
First: you forget tntlistbox3.items.BeginUpdate/tntlistbox3.items.EndUpdate calls (same for tntlistbox4).
Second: Why does my program run faster if I click and hold the caption bar?
Solution (example):
const
UpdateInterval = 500; // half a second
var
...
LastUpdate: Cardinal;
begin
...
LastUpdate := GetTickCount + 100000; // forces first update
For ii := 15 Downto 1 Do //slow change
Begin
For I := 0 To TntListBox1.items.Count - 1 Do //very fast change
Begin
if (GetTickCount > (LastUpdate + UpdateInterval)) or
(GetTickCount < LastUpdate) then
caption := IntToStr(i) + '..' + IntTostr(ii); //problemetic line
...
end;
end;

Resources