I would like to have a function, that when called creates a new stack, do some operations and then disposes the memory it used for stack. How can I do that?
I implemented my stack using an array:
Type stack = record
T :array[1..100] of integer;
top:Integer
end;
Edit:
I want to use the stack in a function, and I want it to be local.
If I do
function A()
var S:stack
begin
code();
end;
Will it dealocate the memory after the variable S once the funcion is done, or do I have to take care of it?
If you use an array (static) implementation you do not need to 'dealocate' memory.
Read this: http://www.freepascal.org/docs-html/ref/refse19.html#x54-610004.1
When a variable is inside a function (procedure), it is deleted after exiting this function.
To implement the stack can be used static array or pointers ... similarly in C language.
simple (no error handling) implementation of stack using array.
program StackExample;
type TStack = record
Items : array [1..5] of integer;
Top: integer;
end;
var Stack : TStack;
function Stack_Init() : TStack;
var
Stack : TStack;
begin
Stack.Top := 1;
Stack_Init := Stack;
end;
procedure Stack_Push(var Stack: TStack; Item : integer);
begin
Stack.Items[Stack.Top] := Item;
Stack.Top := Stack.Top + 1;
end;
function Stack_Pop(var Stack: TStack) : integer;
begin
Stack.Top := Stack.Top - 1;
Stack_Pop := Stack.Items[Stack.Top]
end;
{-----------MAIN------------}
begin
Stack := Stack_Init();
Stack_Push(Stack, 1);
Stack_Push(Stack, 2);
Stack_Push(Stack, 3);
Writeln(Stack_Pop(Stack)); {get >> 3}
Writeln(Stack_Pop(Stack)); {get >> 2}
Writeln(Stack_Pop(Stack)); {get >> 1}
end
.
Related
Good day, I'm doing some Codeforces exercises in my free time, and I had a problem to test if the user was a boy or a girl, well, my problem isn't that, i have just demonstrated the code.
While compiling my code in my computer ( I'm using version 3.0.4 for i386 ) i get no error, but codeforces gives me this error
program.pas(15,16) Error: Operator is not overloaded: "freq(Char;AnsiString):LongInt;" + "ShortInt"
program.pas(46,4) Fatal: There were 1 errors compiling module, stopping
The error wasn't clear enough to me, as the same script was perfectly compiled with my version.
The platform is using ( version 3.0.2 i386-Win32 ).
program A236;
uses wincrt, sysutils;
var
username : String;
function freq(char: char; username : String): Integer;
var
i: Integer;
begin
freq:= 0;
for i:= 1 to length(username) do
if char = username[i] then
freq:= freq + 1;
//writeln(freq);
end;
function OddUserName(username : String): Boolean;
var
i, counter: Integer;
begin
OddUserName:= false; // even
counter:= 0;
for i:= 1 to length(username) do
if freq(username[i], username) <> 1 then
delete(username, i, 1)
else
counter:= counter + 1;
if counter mod 2 <> 0 then
OddUserName:= true; // odd
//writeln(counter);
//writeln(OddUserName);
end;
begin
readln(username);
if not OddUserName(username) then
writeln('CHAT WITH HER!')
else
writeln('IGNORE HIM!');
//readkey();
end.
The error is supposed to be at this line probably :
function freq(character: char; username : String): Integer;
Thanks for everyone who helps.
Inside of a function, the function's name can be used as a substitute for using an explicit local variable or Result. freq() and OddUserName() are both doing that, but only freq() is using the function name as an operand on the right-hand side of an assignment. freq := freq + 1; should be a legal statement in modern Pascal compilers, see Why i can use function name in pascal as variable name without definition?.
However, it would seem the error message is suggesting that the failing compiler is treating freq in the statement freg + 1 as a function type and not as a local variable. That would explain why it is complaining about not being able to add a ShortInt with a function type.
So, you will have to use an explicit local variable instead, (or the special Result variable, if your compiler provides that), eg:
function freq(charToFind: char; username : String): Integer;
var
i, f: Integer;
begin
f := 0;
for i := 1 to Length(username) do
if charToFind = username[i] then
f := f + 1;
//writeln(f);
freq := f;
end;
function freq(charToFind: char; username : String): Integer;
var
i: Integer;
begin
Result := 0;
for i := 1 to Length(username) do
if charToFind = username[i] then
Result := Result + 1;
//writeln(f);
end;
I'm kinda a Delphi-newbie and I don't get how the Sort method of a TList of Records is called in order to sort the records by ascending integer value.
I have a record like the following:
type
TMyRecord = record
str1: string;
str2: string;
intVal: integer;
end;
And a generic list of such records:
TListMyRecord = TList<TMyRecord>;
Have tried to find a code-example in the help files and found this one:
MyList.Sort(#CompareNames);
Which I can't use, since it uses classes. So I tried to write my own compare function with a little different parameters:
function CompareIntVal(i1, i2: TMyRecord): Integer;
begin
Result := i1.intVal - i2.intVal;
end;
But the compiler always throws a 'not enough parameters' - error when I call it with open.Sort(CompareIntVal);, which seems obvious; so I tried to stay closer to the help file:
function SortKB(Item1, Item2: Pointer): Integer;
begin
Result:=PMyRecord(Item1)^.intVal - PMyRecord(Item2)^.intVal;
end;
with PMyRecord as PMyRecord = ^TMyRecord;
I have tried different ways of calling a function, always getting some error...
The Sort overload you should be using is this one:
procedure Sort(const AComparer: IComparer<TMyRecord>);
Now, you can create an IComparer<TMyRecord> by calling TComparer<TMyRecord>.Construct. Like this:
var
Comparison: TComparison<TMyRecord>;
....
Comparison :=
function(const Left, Right: TMyRecord): Integer
begin
Result := Left.intVal-Right.intVal;
end;
List.Sort(TComparer<TMyRecord>.Construct(Comparison));
I've written the Comparison function as an anonymous method, but you could also use a plain old style non-OOP function, or a method of an object.
One potential problem with your comparison function is that you may suffer from integer overflow. So you could instead use the default integer comparer.
Comparison :=
function(const Left, Right: TMyRecord): Integer
begin
Result := TComparer<Integer>.Default.Compare(Left.intVal, Right.intVal);
end;
It might be expensive to call TComparer<Integer>.Default repeatedly so you could store it away in a global variable:
var
IntegerComparer: IComparer<Integer>;
....
initialization
IntegerComparer := TComparer<Integer>.Default;
Another option to consider is to pass in the comparer when you create the list. If you only ever sort the list using this ordering then that's more convenient.
List := TList<TMyRecord>.Create(TComparer<TMyRecord>.Construct(Comparison));
And then you can sort the list with
List.Sort;
The concise answer:
uses
.. System.Generics.Defaults // Contains TComparer
myList.Sort(
TComparer<TMyRecord>.Construct(
function(const Left, Right: TMyRecord): Integer
begin
Result := Left.intVal - Right.intVal;
end
)
);
I want to share my solution (based on the input I have gathered here).
It's a standard setup. A filedata class that holds data of a single file in a generic TObjectList. The list has the two private attributes fCurrentSortedColumn and fCurrentSortAscending to control the sort order. The AsString-method is the path and filename combined.
function TFileList.SortByColumn(aColumn: TSortByColums): boolean;
var
Comparison: TComparison<TFileData>;
begin
result := false;
Comparison := nil;
case aColumn of
sbcUnsorted : ;
sbcPathAndName: begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcSize : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<int64>.Default.Compare(Left.Size,Right.Size);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcDate : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<TDateTime>.Default.Compare(Left.Date,Right.Date);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcState : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<TFileDataTestResults>.Default.Compare(Left.FileDataResult,Right.FileDataResult);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
end;
if assigned(Comparison) then
begin
Sort(TComparer<TFileData>.Construct(Comparison));
// Control the sort order
if fCurrentSortedColumn = aColumn then
fCurrentSortAscending := not fCurrentSortAscending
else begin
fCurrentSortedColumn := aColumn;
fCurrentSortAscending := true;
end;
if not fCurrentSortAscending then
Reverse;
result := true;
end;
end;
I found a much simpler modified sort function to alphabetize a TList of records or nonstandard list of items.
Example
PList = ^TContact;
TContact = record //Record for database of user contact records
firstname1 : string[20];
lastname1 : string[20];
phonemobile : Integer; //Fields in the database for contact info
phonehome : Integer;
street1 : string;
street2 : string;
type
TListSortCompare = function (Item1,
Item2: TContact): Integer;
var
Form1: TForm1;
Contact : PList; //declare record database for contacts
arecord : TContact;
Contacts : TList; //List for the Array of Contacts
function CompareNames(i1, i2: TContact): Integer;
begin
Result := CompareText(i1.lastname1, i2.lastname1) ;
end;
and the function to call to sort your list
Contacts.Sort(#CompareNames);
I was unable to follow how it is working.
A very simple example first, to try explain my situation better.
This code is inside a new Form Form1 create in a new project. Where mmo1 is a Memo component.
TOb = class
Name : String;
constructor Create(Name : String);
procedure Go();
end;
procedure TOb.Go;
begin
Form1.mmo1.Lines.Add(Name);
end;
Then I have a button with this event:
procedure TForm1.btn4Click(Sender: TObject);
var
Index : Integer;
begin
mmo1.Lines.Clear;
for Index := 1 to 3 do
TThread.CreateAnonymousThread(TOb.Create('Thread ' + IntToStr(Index)).Go).Start;
end;
And my output on the memo is:
Thread 4
Thread 4
Thread 4
I really don't got it.
First question: Why the "Name" output is: Thread 4? Is a For loop from 1 to 3. At least should be 1 or 3
Second: Why it only execute the last thread "Thread 4", instead of 3 times in sequence "Thread 1", "Thread 2", "Thread 3"?
Why I'm asking this? I have an object that has already a process working fine. But now I found me in a situation that I need a List of this object to be processed. Sure work fine process one by one, but in my case they are independent one of other so I thought "hm, lets put them in threads, so it will run faster".
To avoid modifying the object to extend TThread and overriding Execute I look up on how to execute a thread with a procedure instead of an object that inherits from TThread and found the Anonymous Thread. Works really great with one object, but when I tried loop through my object list, strange behaviors happens.
This has the same effect.
for Index := 1 to 3 do
TThread.CreateAnonymousThread(
procedure
var
Ob : TOb;
begin
OB := TOb.Create('Thread ' + IntToStr(Index));
OB.Go;
end
).Start;
Sure I'm not clean the object, this was just some tests that I was running.
Any Ideas? Or in this case I will need to inherits from TThread and override the Execute methode?
The funny thing is that THIS runs just fine.
mmo1.Lines.Clear;
TThread.CreateAnonymousThread(TOb.Create('Thread ' + IntToStr(1)).Go).Start;
TThread.CreateAnonymousThread(TOb.Create('Thread ' + IntToStr(2)).Go).Start;
TThread.CreateAnonymousThread(TOb.Create('Thread ' + IntToStr(3)).Go).Start;
Output:
Thread 1
Thread 2
Thread 3
Works really great with one object, but when I tried loop through my object list, strange behaviors happens.
You are likely not taking into account how anonymous procedures bind to variables. In particular:
Note that variable capture captures variables--not values. If a variable's value changes after being captured by constructing an anonymous method, the value of the variable the anonymous method captured changes too, because they are the same variable with the same storage. Captured variables are stored on the heap, not the stack.
For example, if you do something like this:
var
Index: Integer;
begin
for Index := 0 to ObjList.Count-1 do
TThread.CreateAnonymousThread(TOb(ObjList[Index]).Go).Start;
end;
You will actually cause an EListError exception in the threads (I least when I tested it - I don't know why it happens. Verified by assigning an OnTerminate handler to the threads before calling Start(), and then having that handler check the TThread(Sender).FatalException property).
If you do this instead:
var
Index: Integer;
Ob: TOb;
begin
for Index := 0 to ObjList.Count-1 do
begin
Ob := TOb(ObjList[Index]);
TThread.CreateAnonymousThread(Ob.Go).Start;
end;
end;
The threads won't crash anymore, but they are likely to operate on the same TOb object, because CreateAnonymousThread() is taking a reference to the TOb.Go() method itself, and then your loop is modifying that reference's Self pointer on each iteration. I suspect the compiler is likely generating code similar to this:
var
Index: Integer;
Ob: TOb;
Proc: TProc; // <-- silently added
begin
for Index := 0 to ObjList.Count-1 do
begin
Ob := TOb(ObjList[Index]);
Proc := Ob.Go; // <-- silently added
TThread.CreateAnonymousThread(Proc).Start;
end;
end;
If you do this instead, it will have a similar issue:
procedure StartThread(Proc: TProc);
begin
TThread.CreateAnonymousThread(Proc).Start;
end;
...
var
Index: Integer;
Ob: TOb;
begin
for Index := 0 to ObjList.Count-1 do
begin
Ob := TOb(ObjList[Index]);
StartThread(Ob.Go);
end;
end;
Probably because the compiler generates code similar to this:
procedure StartThread(Proc: TProc);
begin
TThread.CreateAnonymousThread(Proc).Start;
end;
...
var
Index: Integer;
Ob: TOb;
Proc: TProc; // <--
begin
for Index := 0 to ObjList.Count-1 do
begin
Ob := TOb(ObjList[Index]);
Proc := Ob.Go; // <--
StartThread(Proc);
end;
end;
This will work fine, though:
procedure StartThread(Ob: TOb);
begin
TThread.CreateAnonymousThread(Ob.Go).Start;
end;
...
var
Index: Integer;
Ob: TOb;
begin
for Index := 0 to ObjList.Count-1 do
begin
Ob := TOb(ObjList[Index]);
StartThread(Ob);
// or just: StartThread(TOb(ObjList[Index]));
end;
end;
By moving the call to CreateAnonymousThread() into a separate procedure that isolates the actual reference to TOb.Go() into a local variable, you remove any chance of conflict in capturing the reference for multiple objects.
Anonymous procedures are funny that way. You have to be careful with how they capture variables.
After reading a the article that Remy Lebeau post on the comments, I found this solution.
changing the main object by add one more procedure that make the call.
Change the loop instead of creating the anonymous thread at the main loop, it is created inside the object.
TOb = class
Name : String;
constructor Create(Name : String);
procedure Process();
procedure DoWork();
end;
procedure TOb.Process;
begin
TThread.CreateAnonymousThread(DoWork).Start;
end;
procedure TOb.DoWork;
var
List : TStringList;
begin
List := TStringList.Create;
List.Add('I am ' + Name);
List.Add(DateTimeToStr(Now));
List.SaveToFile('D:\file_' + Name + '.txt');
List.Free;
end;
And the loop:
List := TObjectList<TOb>.Create();
List.Add(TOb.Create('Thread_A'));
List.Add(TOb.Create('Thread_B'));
List.Add(TOb.Create('Thread_C'));
List.Add(TOb.Create('Thread_D'));
for Obj in List do
//TThread.CreateAnonymousThread(Obj.Go).Start;
Obj.Process;
Thats resolves the problem with just a minimum change on the Main Object.
This about race condition. When you increased to max value to 100, you will see different values. Threading not guarantee when Thread starts or ends.
You can try this code block.
for I := 1 to 100 do
begin
TThread.CreateAnonymousThread(
procedure
var
Msg : string;
begin
try
Msg := 'This' + I.ToString;
MessageDlg(Msg,mtCustom,
[mbYes,mbAll,mbCancel], 0);
Except
on E: Exception do
End;
end
).Start;
end;
If you want a guarantee to write 1 to 4, you should instantiate every value before send to Thread.
for I := 1 to 100 do
begin
TThread.CreateAnonymousThread(
procedure
var
Msg : string;
begin
var instanceValue := I;
try
Msg := 'This' + instanceValue.ToString;
MessageDlg(Msg,mtCustom,
[mbYes,mbAll,mbCancel], 0);
Except
on E: Exception do
End;
end
).Start;
end;
I got a problem in my Lazarus project: everytime I want to use a function it throws the above error (External: SIGSEGV). I don't know what that means, but some debugging showed me, that this is the code, causing the error:
class function TUtils.AsStringArray(const Strs:TStrings): TStringArray;
var
s:string;
i:integer;
begin
SetLength(Result, Strs.Count);
i := 1;
for s in Strs do
begin
Result[i] := s;
i := i + 1;
end;
end;
And the definitions
TStringArray = array of string;
TUtils = class
public
[...]
class function AsStringArray(const Strs:TStrings): TStringArray; static;
end;
The exception occurs after i := i + 1;. I would be really thankful if you could help me!
Dynamic arrays such as TStringArray = array of string; are zero-based; your code uses it as 1-based and raises access violation.
You should replace i := 1; by i := 0;
To the second Problem, it is because you are accesing to the index i, wich at the start it is 1 that is why you have the problem, the range of the array is determined by "length - 1", so if your length is 1, then your range is 0. So to solve the problem in your for loop you have to put Result[i-1] := s; like this you acces the index you really want.
More of this on http://wiki.freepascal.org/Dynamic_array
I learning to make a program that gets data from a txt file and places it in arrays.
the following are its types :
type
ekspedisi = record
nmeksp : string; // Nama Ekspedisi
jlp : string; // Jenis layanan pengiriman
biaya : integer; // Biaya pengiriman per kg
lp : integer; // per hari
end;
ekspedisiku = record
nom : array [1..100] of ekspedisi;
end;
and a simple algorithm
procedure getDaftarEkspedisi(var kirim : ekspedisiku);
var
i,j,k : integer;
eksp : text;
init : string;
garis : array [1..100] of integer;
mark : string;
jeks : integer;
count : integer;
begin
assign(eksp,'ekspedisi.txt');
reset(eksp);
i := 0;
k := 1;
j := 1;
mark := '|';
jeks := 10;
writeln('Loading ekspedisi.. ');
while(not(eof(eksp))) do
begin
readln(eksp,init);
i := i + 1;
for j := 1 to length(init) do
begin
if init[j] = mark then
begin
garis[k] := j;
k := k + 1;
end;
end;
for i := 1 to jeks do
begin
count := ((i-1)*5);
kirim.nom[i].nmeksp := copy(init,garis[1+count] + 2,garis[2+count]-garis[1+count]-2);
kirim.nom[i].jlp := copy(init,garis[2+count] + 2,garis[3+count]-garis[2+count]-2);
val(copy(init,garis[3+count] + 2,garis[4+count]-garis[3+count]-2),kirim.nom[i].biaya);
val(copy(init,garis[4+count] + 2,garis[5+count]-garis[4+count]-2),kirim.nom[i].lp);
end;
close(kirim);
writeln('loading sukses.');
end;
end;
from that code, i get the following error
<166,13>Error: Call by var for arg no.1 has to match exactly : got "ekspedisiku" expected "Text"
curiously, line 166 is only
close(kirim);
any help is appreciated.
You need to pass the file handle to close, so:
close(kirim);
should be:
close(eksp);
It also looks like you're closing the file at the wrong place in your function. It should most likely be after the while loop, so you need to change:
close(kirim);
writeln('loading sukses.');
end;
end;
to:
end;
close(kirim);
writeln('loading sukses.');
end;
Note that this mistake probably happened because your identation is messed up - if you're careful with formatting your code properly then you won't be so likely to make this kind of error.