It's actually my first time in here, so..
What's the problem: standard graph module is too damn slow in drawing.
I have an institute task to make a big program with modules on pascal. Program has several parts but i'm interested in graphical one. I have something like counter (number) in the left corner of the screen and i need it to update fast. But I see every pixel it fills with color, lol.
I'm using Free Pascal 2.6.4.
Asking for some ideas or other ways to draw in a command window fast.
program graphical;
uses
wincrt, graph, querystring, kbd, Timer, sysutils;
const
speedX1 = 0;
speedY1 = 0;
var
//draw part
gd, gm, error, tw, th, i: integer;
speedX2: integer = 10;
speedY2: integer = 10;
speedSize: word;
speedImage: pointer;
size: word;
//qstring part
qrec: qstr;
qtext: AnsiString;
current, ch: char;
//keyboard part
kbrd: kb;
//speedometer part
counter: word = 0;
time: word;
speed: word;
//debug part
c: string;
t: comp;
procedure draw; //screens text
begin
qtext := copy(qrec.text, qrec.qpointer, Length(qrec.text) - qrec.qpointer + 1);
outTextXY(getMaxX div 2, getMaxY div 8, qtext);
end;
begin
//graphic initialization
//gd := detect;
gd := VGA;
gm := VGAHi;
initgraph(gd, gm, '..\bgi');
//checking for errors
error := graphResult;
if (error <> grOk) then
begin
writeln('800x600x256 is not supported');
halt(1);
end;
//querystring initialization
qInit(qrec);
//keyboard initialization
initKeyboard(kbrd);
//timer initialization
TimerOn;
time := 0;
//drawing
setTextStyle(defaultFont, horizDir, 8);
draw;
drawKeyboard(kbrd);
current := getCurrent(qrec);
randomize;
speedX2 := 200;
speedY2 := 100;
repeat
//on timer events
if (isTimer) then
begin
size := ImageSize(speedX1, speedY1, speedX2, speedY2);
GetMem(speedImage, size);
GetImage(speedX1, speedY1, speedX2, speedY2, speedImage^);
PutImage(speedX1, speedY1, speedImage^, 1); FreeMem(speedImage, size);
inc(time);
speed := round(counter/time/25*60);
speed := time;
outTextXY(0, 0, IntToStr(speed));
end;
if KeyPressed then
begin
ch := readkey;
if (ch = #0) then
ch := readkey;
end;
if (UpCase(ch) = UpCase(current)) then
begin
drawKeyboard(kbrd);
draw;
current := getCurrent(qrec);
inc(counter);
end
else
if (counter > 0) then
dec(counter);
until (ch = #27) or (getLength(qrec) < 0);
closegraph;
end.
What I see from the code:
drawKeyboard is called on each iteration, which might not be necessary
for each timer event, memory is allocated and released again, which normally is a rather costly operation. The memory needed seems to be of constant size, so try to move allocation and deallocation out of the loop.
Without fixing those, you'd probably have the same problems with other graph libraries too, so give it a try.
Related
You play a game with 100 opponents. The game has k rounds. Every round you can eliminate some opponents (always atleast 1). You are rewarded for eliminating them.
The reward is: 100.000 * '# of eliminated opponents' / '# of opponents' <= in integers (rounded down)
I want to eliminate the opponents in a way, that gets me the largest amount of money possible.
Example game:
number of rounds = 3
first round we eliminate 50 opponents, so we get 100.000 * 50 / 100 = +50.000
second round we eliminate 30, so we get 100.000 * 30 / 50 = +60.000
last round we eliminate last 20 opponents, so we get 100.000 * 20 / 20 = +100.000
so the total winnings are: 210.000
I tried to write up something, but I don't think it's the most effective way to do it?
Program EliminationGame;
var
selectedHistory : array [1..10] of integer;
opponentCount,roundCount : integer;
maxOpponents,numberSelected : integer;
totalMoney : integer;
i : integer;
begin
totalMoney := 0;
maxOpponents := 100;
opponentCount := maxOpponents;
roundCount := 3; {test value}
for i:=1 to roundCount do begin
if (i = roundCount) then begin
numberSelected := opponentCount;
end else begin
numberSelected := floor(opponentCount / roundCount);
end;
selectedHistory[i] := numberSelected;
totalMoney := floor(totalMoney + (numberSelected / opponentCount * 100000));
opponentCount := opponentCount - numberSelected;
end;
writeln('Total money won:');
writeln(totalMoney);
writeln('Amount selected in rounds:');
for i:= 0 to Length(selectedHistory) do
write(selectedHistory[i],' ');
end.
Also it seems that floor function does not exist in pascal?
It seems the question has a maths answer that can be calculated in advance. As #Anton said it was obvious that the number of points given during the third round did not depend upon the number of eliminated enemies. So the third round should eliminate 1 enemy.
So We get the following function for a thre-round game.
f(x)=100000x/100+100000(99-x)/(100-x)+100000*1/1, where x- the number
of enemies eleminated at first round.
if we find the extrema (local maximum of the function) it appears equal to 90. That means the decision is the following: the first round eliminates 90 the second - 9, the third - 1 enemy.
Of course, for consideration: 90=100-sqrt(100).
In other words: the Pascal decision of the task is to loop a variable from 1 to 99 and see the maximum of this function. X-will be the answer.
program Project1;
var
x, xmax: byte;
MaxRes, tmp: real;
begin
xmax := 0;
MaxRes := 0;
for x := 1 to 99 do
begin
tmp := 100000 * x / 100 + 100000*(99 - x) / (100 - x) + 100000 * 1 / 1;
if tmp > MaxRes then
begin
MaxRes := tmp;
xmax := x;
end;
end;
writeln(xmax);
readln;
end.
The general decision for other number of enemies and rounds (using recursion) is the following (Delphi dialect):
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
Uses System.SysUtils;
var
s: string;
function Part(RemainingEnemies: byte; Depth: byte;
var OutputString: string): real;
var
i: byte;
tmp, MaxRes: real;
imax: byte;
DaughterString: string;
begin
OutputString := '';
if Depth = 0 then
exit(0);
imax := 0;
MaxRes := 0;
for i := 1 to RemainingEnemies - Depth + 1 do
begin
tmp := i / RemainingEnemies * 100000 + Part(RemainingEnemies - i, Depth - 1,
DaughterString);
if tmp > MaxRes then
begin
MaxRes := tmp;
imax := i;
OutputString := inttostr(imax) + ' ' + DaughterString;
end;
end;
result := MaxRes;
end;
begin
writeln(Part(100, 3, s):10:1);//first parameter-Enemies count,
//2-Number of rounds,
//3-output for eliminated enemies counter
writeln(s);
readln;
end.
This problem can be solved with a dynamic approach.
F(round,number_of_opponents_remained):
res = 0
opp // number_of_opponents_remained
for i in [1 opp]
res = max(res, opp/100 + F(round-1,opp - i) )
return res
I should say this not the complete solution and you add some details about it, and I am just giving you an idea. You should add some details such as base case and checking if opp>0 and some other details. The complexity of this algorithm is O(100*k).
I have this function called IntToStrLen which converts an integer to a string of a padded size. For example, an integer value of 42 with a size of 4 would result in a string __42 (padded with a given character, space by default).
The problem is when this function is used in bulk (for example 1,000,000 times in a loop), it adds extra weight onto the loop. The loop I'm using this in, without this function, takes about 20 seconds, but with this function, I'm still waiting as of right now for this function to complete, after about 5 minutes.
How can I speed up the following function?
function IntToStrLen(const Value: Integer; const Len: Integer;
const Fill: String = ' '): String;
var
T: String;
begin
Result:= IntToStr(Value); //convert result
if Length(Result) > Len then
Result:= Copy(Result, 1, Len) //forcefully truncate
else if Length(Result) < Len then begin
T:= '';
while Length(T) < (Len - Length(Result)) do //fill space with character
T:= T + Fill;
Result:= T + Result; //return combination
end;
end;
The absolute number one change that you can make here is to avoid heap allocations. Your code presently has multiple heap allocations. Your goal here is to write a function with zero heap allocations.
That means you need the caller to allocate and provide the buffer. Typically they will do so with a stack allocated buffer, which hence costs nothing to allocate (or deallocate). If the caller really needs a string, which is always allocated on the heap, then the caller can wrap your function with a call to SetString.
The function prototype might look like this:
procedure IntToStrLen(const Value, Len: Integer; var Buffer: array of Char;
const Fill: Char = ' ');
The first point to stress here is that Fill must be a Char. Your use of string is inefficient and allows the caller to call a fill "character" with length not equal to one. Doing so would of course break your function because it would return a value with length not equal to Len.
Do note also that the implementation must not call IntToStr because that involves heap allocation. So you need to write your own heap allocation free integer to decimal text conversion code because, astonishingly, the RTL does not offer such functionality. When I do this I use code like so:
procedure DivMod(Dividend, Divisor: Cardinal;
out Quotient, Remainder: Cardinal);
{$IFDEF CPUX86}
asm
PUSH EBX
MOV EBX,EDX
XOR EDX,EDX
DIV EBX
MOV [ECX],EAX
MOV EBX,Remainder
MOV [EBX],EDX
POP EBX
end;
{$ELSE IF Defined(CPUX64)}
asm
.NOFRAME
MOV EAX,ECX
MOV ECX,EDX
XOR EDX,EDX
DIV ECX
MOV [R8],EAX
MOV [R9],EDX
end;
{$ELSE}
{$Message Error 'Unrecognised platform.'}
{$ENDIF}
function CopyIntegerToCharBuffer(const Value: Integer;
var Buffer: array of Char): Integer;
var
i, j: Integer;
val, remainder: Cardinal;
negative: Boolean;
tmp: array [0..15] of Char;
begin
negative := Value<0;
val := abs(Value);
Result := 0;
repeat
DivMod(val, 10, val, remainder);
tmp[Result] := Chr(remainder + ord('0'));
inc(Result);
until val=0;
if negative then begin
tmp[Result] := '-';
inc(Result);
end;
Assert(Result<=Length(Buffer));
i := 0;
j := Result-1;
while i<Result do begin
Buffer[i] := tmp[j];
inc(i);
dec(j);
end;
end;
Now you can make decimal text representations of integers without touching the heap. From there it's a short way to your function.
procedure IntToStrLen(const Value, Len: Integer; var Buffer: array of Char;
const Fill: Char = ' ');
var
tmp: array [0..15] of Char;
i, N: Integer;
begin
Assert(Length(Buffer)>=Len);
N := CopyIntegerToCharBuffer(Value, tmp);
if N>=Len then begin
Move(tmp, Buffer, SizeOf(Char)*Len);
end else begin
for i := 0 to Len-N-1 do begin
Buffer[i] := Fill;
end;
Move(tmp, Buffer[Len-N], SizeOf(Char)*N);
end;
end;
At this point you'll have gained the bulk of the available performance benefits. From here on in you will be into diminishing returns. You could micro-optimise CopyIntegerToCharBuffer as is done in SysUtils._IntToStr32 for instance. Beyond that I'm sure the implementation of IntToStrLen could be optimised with judicious use of assembler. But such optimisations will yield nothing like the benefit you have gained so far from avoiding the heap.
Of course, all this assumes that you have correctly identified your performance bottleneck. It's all too easy to assume that you know where the performance bottleneck is by statically analysing the code. Unless you've actually profiled it carefully expect to find that your intuition is a poor judge of where to invest optimisation effort.
Try this variant
(and you don't treat negative numbers)
function IntToStrLen(const Value: Integer; const Len: Integer;
const Fill: Char = ' '): String;
var
T: String;
begin
Result:= IntToStr(Value);
if Length(Result) > Len then
SetLength(Result, Len) //forcefully truncate
else if Length(Result) < Len then
Result := StringOfChar(Fill, Len - Length(Result)) + Result;
end;
P.S. So strange truncation (2014=>20) - is what you really want?
I am not getting the correct memory sizes of all the component selected in the component page.
Please give me a solution how the total memory selected for all the components should be correct?
The memory size is displayed on the label at the bottom of the page.
If in the [files] section check flags are used, not all flags can be processed by Inno-setup. Especially if you created check flags which rely on the [code] section.
In my setup a created an array of all files.
In this record I have a selected flag, and a filesizeflag.
An example looks like:
files[index].selected := // true or false depending on your wizard flow
files[index].filesize := {#filesize(..)} // on the .. the source file, including path
Before calling the dir page wizard page you go through a procedure which counts the file sizes and adds them to the file size already counted.
Yhe file size already counted is for every setup different, depending how much code you have in the code section is my experience.
My example code for counting the space is a good start (I hope)
Procedure GetSetUsedDiskSpace();
// This procedure counts an displays the used disk space
{}
var
TempS, SearchString, NumberString, diskspace : String;
Position, p2 : Integer;
Tot_disk, TempSpace : Longint;
{}
begin
TempS := InitDiskSpace; // wizardform.DiskSpaceLabel.Caption;
SearchString := 'MB';
Position := pos(SearchString, TempS);
NumberString := copy(TempS, 1, Position-2); // exclusive the space before the MB
p2 := 0;
repeat // find the space before the number
p2 := pos(' ', NumberString);
NumberString := copy(NumberString, p2 + 1, length(NumberString) - p2);
until p2 = 0;
p2 := pos(',', NumberString);
if (p2 = 0) then
begin // Some languages use the period as a decimal separator
p2 := pos('.', NumberString);
end;
if (p2 > 0) then
begin
NumberString := copy(Numberstring, 1, p2-1) + copy(NumberString, p2+1, 1);
// If there is a need to more shifting we add some code
end;
TempSpace := StrToInt(NumberString);
TempSpace := TempSpace * 1024 * 1024; // Conversion to bytes
TempSpace := TempSpace / 10; // We replaced the decimal separator once
CountSpace; // Count the space for our selection
Tot_disk := UsedDiskSpace + TempSpace; // The total in bytes
UsedDiskSpace := Tot_disk; // We need this for the control panel
Tot_disk := Tot_disk / 1024; // The total in kilobytes
Tot_disk := Tot_disk / 1024; // The total in MB
diskspace := IntToStr(Tot_disk);
TempS := SetupMessage(msgDiskSpaceMBLabel);
StringChangeEx(TempS, '[mb]', diskspace, True);
WizardForm.DiskSpaceLabel.Caption := TempS;
end;
I have written a recursive Tree Function in pascal ( or delphi ) but i had an 'Out of Memory' message when I ran it.
I need to turn the Calculate recursive function in this code to non-recursive function, can you tell me how please :
program testing(input, output);
type
ptr = ^tr;
tr = record
age: byte;
left, right: ptr;
end;
var
topper: ptr;
total, day: longint;
procedure mycreate(var t: ptr);
var
temp:ptr;
begin
new(temp);
temp^.age := 1;
temp^.left := nil;
temp^.right := nil;
t := temp;
end;
procedure gooneday(var t: ptr);
begin
if t^.age <> 5 then
begin
if t^.age = 2 then
mycreate(t^.left)
else if t^.age = 3 then
mycreate(t^.right);
t^.age := t^.age + 1;
total := total + 1;
end;
end;
procedure calculate(var crnt: ptr);
begin
if crnt <> nil then
begin
gooneday(crnt);
calculate(crnt^.left);
calculate(crnt^.right);
end;
end;
begin
total := 0;
mycreate(topper);
day := 0;
while total < 1000000000000 do
begin
total := 0;
day := day + 1;
calculate(topper);
end;
writeln(day);
writeln(total);
end.
Recursive functions use a stack to keep the state of the recursion.
When converting to a loop, you must actually create an explicit stack. You must push and pop elements off the stack within the loop.
I'm posting this in the spirit of answering your own questions.
The question I had was: How can I implement the Levenshtein algorithm for calculating edit-distance between two strings, as described here, in Delphi?
Just a note on performance:
This thing is very fast. On my desktop (2.33 Ghz dual-core, 2GB ram, WinXP), I can run through an array of 100K strings in less than one second.
function EditDistance(s, t: string): integer;
var
d : array of array of integer;
i,j,cost : integer;
begin
{
Compute the edit-distance between two strings.
Algorithm and description may be found at either of these two links:
http://en.wikipedia.org/wiki/Levenshtein_distance
http://www.google.com/search?q=Levenshtein+distance
}
//initialize our cost array
SetLength(d,Length(s)+1);
for i := Low(d) to High(d) do begin
SetLength(d[i],Length(t)+1);
end;
for i := Low(d) to High(d) do begin
d[i,0] := i;
for j := Low(d[i]) to High(d[i]) do begin
d[0,j] := j;
end;
end;
//store our costs in a 2-d grid
for i := Low(d)+1 to High(d) do begin
for j := Low(d[i])+1 to High(d[i]) do begin
if s[i] = t[j] then begin
cost := 0;
end
else begin
cost := 1;
end;
//to use "Min", add "Math" to your uses clause!
d[i,j] := Min(Min(
d[i-1,j]+1, //deletion
d[i,j-1]+1), //insertion
d[i-1,j-1]+cost //substitution
);
end; //for j
end; //for i
//now that we've stored the costs, return the final one
Result := d[Length(s),Length(t)];
//dynamic arrays are reference counted.
//no need to deallocate them
end;