TPascal, Stack Overflow, Recursion - pascal

My program should inverse a string (ex. for Hello world returns dlrow olleH) and it works only for strings smaller than 20 characters. For 20 or more i get "Error 202 Stack overflow". Thank you :)
Program Inv;
var S, A: String;
n: integer;
Function I(X: String; z: integer):String;
begin
if z=1 then I:=X[z] else
I:=X[z]+I(X, z-1);
end;
begin
write ('Enter your text: ');
readln (S);
n:=length(S);
A:=I(S, n);
writeln (A);
readln;
end.

Unless you are required to show a recursive solution, you're usually better to sticking with iteration(a). Recursion uses an often-limited resource (the stack) to weave its magic and is often the cause of crashes when you exceed that limit.
Iterative solutions tend to be far less restrictive, such as the code below:
program PaxCode;
Function reverse(inp_str: string) : string;
var out_str : string = '';
var idx : integer = 1;
begin
while (idx <= length(inp_str)) do
begin
out_str := inp_str[idx] + out_str;
idx := idx + 1
end;
reverse := out_str
end;
var test_str: string = 'My hovercraft is full of eels and they will not let me drive it';
begin
writeln(test_str);
writeln(reverse(test_str))
end.
As you can see, the output is correct, and not limited to twenty (or twenty-nine) characters:
My hovercraft is full of eels and they will not let me drive it
ti evird em tel ton lliw yeht dna slee fo lluf si tfarcrevoh yM
(a) The best areas for recursion are those where each level removes a sizable proportion of the solution space. For example, binary searches remove fully 50% of the remaining solution space on every level so you could search through a structure holding four billion entries with just thirty-two levels, since 232 is a touch above 4.2 billion.
Something like reversing a 400-character string will take, ..., let me think, oh yes, 400 levels. That won't necessarily end well :-)

Related

Implement x^(e) in Extended Pascal, without using exponentiation operators

Part of a Pascal ISO 10206 program I am building, requires me to implement a function to exponentiate a real number (x) to Eulers number (e), without using any exponentiation functions already included in Pascal(**,pow,exp...).
I have been trying different algorithms for hours but I cant figure out how to do it without using the already included exponentiation functions.
Any help would be appreciated. Any mathematical algorithm of some sort etc... Thanks in advance.
As others have said, it doesn't make sense not to use Exp() or a function based upon it. But if you really must use something else, and don't want to get too technical/mathematical, then the following should work (the real algorithm is far more complicated and requires much more knowledge of math).
The program uses a combination of the first N terms of Taylor series for the fraction of X and binary exponentiation for the integer part of X. It is probably not very fast, but pretty accurate, even for larger exponents. For comparison, I also display Exp(X). If your Pascal has a Double or Extended type, use those instead of Real.
program SimplePower;
{ Required for Delphi, you can omit it in other Pascals: }
{$APPTYPE CONSOLE}
{ Returns approximate value of e^X using sum of first N terms of Taylor series.
Works fine with X values between 0 and 1.0 and N ~ 30. }
function Exponential(N: Integer; X: Real): Real;
var
I: Integer;
begin
Result := 1.0;
for I := N - 1 downto 1 do
Result := 1.0 + X * Result / I;
end;
{ Binary exponentiation of Base by integer Exponent. }
function IntegerExp(Base: Real; Exponent: Integer): Real;
begin
Result := 1.0;
while Exponent > 0 do
begin
if Odd(Exponent) then
Result := Result * Base;
Base := Base * Base;
Exponent := Exponent shr 1;
end;
end;
{ Combines IntegerExp function for integral part with
Exponential function for fractional part. }
function MyExp(N: Integer; X: Real): Real;
const
E = 2.7182818284590452353602874713527; { from Google: "e euler" }
var
Factor: Real;
Fraction: Real;
begin
Fraction := Exponential(N, Frac(X));
Factor := IntegerExp(E, Trunc(X));
Result := Factor * Fraction;
end;
{ Simple demo: }
const
N = 30;
X = 73.4567890242421234;
begin
Writeln('MyExp(', N, ', ', X:22:18, ') = ', MyExp(N, X):22:18);
Writeln('Exp(', X:22:18, ') = ', Exp(X):22:18);
end.
Ref:
Taylor series for exponentiation
Binary exponentiation
I did not do anything for negative exponents, but just know that Exp(-x) = 1/Exp(x). You could amend MyExpwith that knowledge.
I used the solution pointed out by #RudyVelthuis in some other post, but modified it a bit. It is based upon that x^0.5 = sqrt(x), which we can use to our advantage. Ill leave the Pascal ISO 10206 code I used attached. Thank you all for your help, specially Rudy.
function MyPow(base,power,precision:real):real;
begin
if (power<0) then MyPow:=1/MyPow(base,-power,precision)
else if (power>=10) then MyPow:=sqr(MyPow(base,power/2,precision/2))
else if (power>=1) then MyPow:=base*MyPow(base,power-1,precision)
else if (precision>=1) then MyPow:=sqrt(base)
else MyPow:=sqrt(MyPow(base,power*2,precision*2));
end;

Dynamic array in Turbo Pascal

I am working on my school project and I would like to use Dynamic (not static) array. I worked with ObjectPascal, so I am used to some syntax. But now I am programming in the old TurboPascal (I am using Turbo Pascal 7 for Windows).
It doesn't seem to know the ObjectPascal, so I thought, that you Turbo Pascal doesn't know dynamic arrays.
Could anyone tell me, if my theory is right or not? I tried to google, but I was not succesfull.
Basicly I am asking "how is it with dynamic arrays in Turbo Pascal 7" ?
Thank you for all reactions.
As MartynA says, there is no dynamic array type in Turbo Pascal. You need to manually allocate memory using pointers, and be careful if you use rangechecks.
Typically you define an array type
TYPE
TArrayT = array[0.. ((65535-spillbytes) div sizeof(T))-1] of T;
where spillbytes is a constant for a small deduction because you can't use the whole 64k, see what the compiler accepts. (Probably this deduction is for heapmanager structures inside the 64k block)
Then you define a pointer
PArrayT= ^TArrayT;
and a variable to it
var
P : PArrayT;
and you allocate nrelement elements using getmem;
getmem(P,SizeOf(T) * nrelements);
and optionally fill them with zero to initialize them:
fillchar(p^,SizeOf(T) * nrelements,#0);
You can access elements using
p^[index]
to free them, use freemem using the exact opposite of the getmem line.
freemem(P,Sizeof(T)*nrelements);
Which means you have to save the allocated number of elements somewhere. This was fixed/solved in Delphi and FPC.
Also keep in mind that you can't find bugs with rangechecking anymore.
If you want arrays larger than 64k, that is possible, but only with constraints, and it matters more which exact TP target (dos, dos-protected or Windows you use) I advise you to search for the online SWAG archive that has many examples. And of course I would recommend to go to FreePascal/Lazarus too where you can simply do:
var x : array of t;
begin
setlength(x,1000000);
and be done with it without additional lines and forget about all of this nonsense.
I'm using Turbo Pascal 5.5 and to create a dynamic array, perhaps the trick is to declare an array with zero dimension as follows:
dArray = array [0..0] of integer;
And then declare a pointer to that array:
pArray = ^dArray ;
And finally, create a pointer variable:
ArrayPtr : pArray;
You can now reference the pointer variable ArrayPtr as follows:
ArrayPtr^[i]; { The index 'i' is of type integer}
See the complete example below:
{
Title: dynarr.pas
A simple Pascal program demonstrating dynamic array.
Compiled and tested with Turbo Pascal 5.5.
}
program dynamic_array;
{Main Program starts here}
type
dArray = array [0..0] of integer;
pArray = ^dArray ;
var
i : integer;
ArrayPtr : pArray;
begin
for i := 0 to 9 do { In this case, array index starts at 0 instead of 1. }
ArrayPtr^[i] := i + 1;
writeln('The Dynamic Array now contains the following:');
writeln;
for i := 0 to 9 do
writeln(ArrayPtr^[i]);
end.
In this example, we have declared the array as:
array[0..0] of integer;
Therefore, the index starts at 0 and if we have n elements, the last element is at index n-1 which is similar to array indexing in C/C++.
Regular Pascal arrays start at 1 but for this case, it starts at 0.
unit Vector;
interface
const MaxVector = 8000;
// 64 k div SizeOf(float); number of float-values that fit in 64 K of stack
VectorError: boolean = False;
// toggle if error occurs. Calling routine can handle or abort
type
VectorStruc = record
Length: word;
Data: array [1..MaxVector] of float;
end;
VectorTyp = ^VectorStruc;
procedure CreateVector(var Vec: VectorTyp; Length: word; Value: float);
{ Generates a vector of length Length and sets all elements to Value }
procedure DestroyVector(var Vec: VectorTyp);
{ release memory occupied by vector }
procedure SetVectorElement(var Vec: VectorTyp; n: word; c: float);
function GetVectorElement(const Vec: VectorTyp; n: word): float;
implementation
var ch: char;
function WriteErrorMessage(Text: string): char;
begin
Write(Text);
Read(WriteErrorMessage);
VectorError := True; // toggle the error marker
end;
procedure CreateVector(var Vec: VectorTyp; Length: word; Value: float);
var
i: word;
begin
try
GetMem(Vec, Length * SizeOf(float) + SizeOf(word) + 6);
except
ch := WriteErrorMessage(' Not enough memory to create vector');
exit;
end;
Vec^.Length := Length;
for i := 1 to Length do
Vec^.Data[i] := Value;
end;
procedure DestroyVector(var Vec: VectorTyp);
var
x: word;
begin
x := Vec^.Length * SizeOf(float) + SizeOf(word) + 6;
FreeMem(Vec, x);
end;
function VectorLength(const Vec: VectorTyp): word;
begin
VectorLength := Vec^.Length;
end;
function GetVectorElement(const Vec: VectorTyp; n: word): float;
var
s1, s2: string;
begin
if (n <= VectorLength(Vec)) then
GetVectorElement := Vec^.Data[n]
else
begin
Str(n: 4, s1);
Str(VectorLength(Vec): 4, s2);
ch := WriteErrorMessage(' Attempt to read non-existent vector element No ' +
s1 + ' of ' + s2);
end;
end;
procedure SetVectorElement(var Vec: VectorTyp; n: word; C: float);
begin
if (n <= VectorLength(Vec)) then
Vec^.Data[n] := C
else
ch := WriteErrorMessage(' Attempt to write to non-existent vector element');
end;
end.
As long as your data fit on the stack, i.e., are smaller than 64 kB, the task is relatively simple. The only thing I don't know is where the 6 bit of extra size go, they are required, however.

Most repeated character in a row

My task is to show most used letter in a row. For example if you put in aabbbbccbbb most repeated character is B and it is used 4 times. There was a very similar topic about the same task, but i didnt understand the code. Most repeating character in a string
Program Task;
var s:string;
i,k,g,count:integer;
c:char;
begin
Readln(s);
g:=0;
while Length(s) > 0 do
begin
c := s[1];
i:=1;
while i<= Length(s) do
begin
If (c=s[i]) then
delete(s,i,1)
else
Inc(i);
If (c=s[i]) then
Inc(g);
end;
end;
Writeln(g);
Readln;
end.
There are many problems i face. First is i dont know how to show which character is most used and second is i dont know how compare which one of repeating characters is most used.
For example if i write aaaabbbc it will give me answer of 7 because there is 4xa and 3xb.
All the help is most appreciated.
If it's just about english characters, you might just allocate an array to keep a count per character. In that case, the code could look like this.
I wrote this using Delphi. I hope it works as well in your flavour of Pascal.
program Task;
{$APPTYPE CONSOLE} // For Delphi
var
s: string[50];
i: Integer;
Counters: array[Char] of Integer;
Highest: Char;
begin
// Initialize counters.
for i := 0 to 255 do
Counters[Char(i)] := 0;
s := 'aabbbbccbbb';
// Count the characters.
for i := 1 to Length(s) do
Inc(Counters[s[i]]);
// Find out which one is highest.
Highest := #0;
for i := 0 to 255 do
if Counters[Char(i)] > Counters[Highest] then
Highest := Char(i);
// Output that character and its count.
WriteLn('The highest character is ', Highest, ' with ', Counters[Highest], ' occurrences.');
ReadLn;
end.
In less academic setups, using an array like this might not be the most efficient, because it contains a counter for every possible character, including those that don't occur in the string at all. That means, if you want to use this exact code for every possible character in the unicode table, your array would be a couple of megabytes large (still not really a problem on modern computers, but still).
You can improve this code by using a kind of dictionary or list to keep track of the items, so you need only to add those items you find, but if you have to write that yourself, it will make your program quite a bit larger.
EDIT:
As per request in comment: Counting the longest subsequent range of characters:
program Task;
{$APPTYPE CONSOLE} // For Delphi
var
s: String;
i: Integer;
Longest: Integer;
Current: Integer;
LongestChar: Char;
begin
s := 'aabbbbccbbb';
Longest := 0;
Current := 0;
// Count the characters.
for i := 1 to Length(s) do
begin
Inc(Current);
// If it's the last char or the next char is going to be different, restart the counting.
if (i = Length(s)) or (s[i] <> s[i+1]) then
begin
if Current > Longest then
begin
Longest := Current;
LongestChar := s[i];
end;
Current := 0;
end;
end;
// Output that character and its count.
WriteLn('The highest character is ', LongestChar, ' with ', Longest, ' occurrences.');
ReadLn;
end.
Current > Longest makes sure the first longest sequence is returned in case multiple character sequences have the same length. Change to Current >= Longest if you want the last sequence instead.

When the program runs, writes ->->->->. Why does it do that?

Here is the textfile that the program must read, and put every num. in a different variable.
The first num., in this case 3, is the n, and tells the procedure the program how many times to be done. Between the nums., there is a space.
The text file f is like that
3 2
2 1
1 5
4 2
When it runs the code the following thing keeps being writen
->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->
->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->
->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->
->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->
->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->
->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->->
Why do that happeen?
Can anyone please help me with this program?
The code is the following one.
Program thefinalp;
Uses SysUtils;
Var
f: Text;
m, d: Integer;
n: Char;
c: String[1];
a, e: array of Integer;
LowArr: Integer;
HighArr: Integer;
ArrayLen: Integer;
i: Integer;
begin
Assign(f, 'd:\tempfiles\finalp.txt');
Reset(f);
repeat
Readln(f, n);
Write(n);
until (n = ' ');
Read(f, c);
Write(c);
while not SeekEoln(f) do
begin
read(f, d);
Write(d);
End;
Readln;
Writeln;
StrToIntDef(n, m);
setlength(a, m);
LowArr := Low(a);
HighArr := High(a);
ArrayLen := Length(a);
setlength(e, m);
LowArr := Low(e);
HighArr := High(e);
ArrayLen := Length(e);
for i := LowArr to HighArr do
begin
repeat
Read(f, a[i]);
Write(a[i]);
until (n = ' ');
Read(f, c);
Write(c);
while not SeekEoln(f) do
begin
read(f, e[i]);
Write(e[i]);
End;
Readln;
Writeln;
End;
Readln;
End.
In your first repeat until, you are readlning into a char. The first character will appear in n and the remainder of the characters will be skipped entirely until the newline has been read. AT that point, your file-pointer will be at 2 on the second line of data.
Since your test is for n=' ' then the readln will again be executed, this time delivering 2 into n and pushing the file-pointer to the 1 on the third line.
When eventually end-of-file is reached, a Control-Z character is 'read' from the file. This is the character you are seeing. Since it isn't Space, the loop continues forever.
Change the readln here to a read and one character will be read. (then it works, and you can go on to the next problem...)
Remember, readln reads until it has read a newline. Read reads into the variable - if it's a char, it reads one char. If it's a string, it reads a string - but not the newline.
Program thefinalp;
Uses SysUtils;
Var
f:Text;
m,d:Integer;
n:string;
n2:string;
c:String[1];
a,e:array of integer;//dynamic array//
LowArr:Integer;
HighArr:Integer;
ArrayLen:Integer;
i:Integer;
ch : char;
function readinteger : string;
var
st : string;
begin
st := '';
// read up to first digit
repeat
read(f,ch);
write(ch);
until ch in ['0'..'9'];
//accumulate digits
repeat
st := st + ch;
read(f,ch);
write(ch);
until not (ch in ['0'..'9']);
readinteger := st;
end;
begin
Assign(f,'q21366050.txt');
Reset(f);
// read first integer
n:= readinteger;
// read second integer
n2:= readinteger;
m := StrToInt(n); //puts a string into an integer//
setlength(a,m);
LowArr:=Low(a);
HighArr:=High(a);
ArrayLen:=Length(a);
setlength(e,m);
LowArr:=Low(e);
HighArr:=High(e);
ArrayLen:=Length(e);
for i:= LowArr to HighArr do
begin
// read first integer
n:= readinteger;
// read second integer
n2:= readinteger;
a[i]:=StrToInt(n); //puts a string into an integer//
e[i]:=StrToInt(n2); //puts a string into an integer//
End;
Writeln;
writeln('Results');
for i:= LowArr to HighArr do
writeln(inttostr(i),'=',inttostr(a[i]),',',inttostr(e[i]));
// pause to read results
Readln;
End.
Unfortunately, it's a little difficult to figure out just exactly what you want to do. This routine will read the first line and then put the remaining lines into a[?] and e[?].
Using descriptive variablenames would perform some of the documentation so you can follow what is happening. Since I don't actually know, I'm having to make assumptions and make a few things up to fill in the gaps.
Looking at the main routine, first you assign a filename (I used q21366050.txt for my convenience) and open the file with a reset.
Next job is to read the first number in from the file. Now you have only shown single-digit numbers, but it's easy to set the routine to cope with a sequence.
n:=readinteger;
assigns the result of the function readinteger to the string n
readinteger works this way: first clear the string st which is a "local variable" - only available to this routine. Then keep reading characters into ch until the character read is in the range '0'..'9' - so it skips until it reads a digit. Then it adds the digit read to the string st and continues to read characters and accumulate them until the character found is not a digit. (That character, should we need it, is in ch) We then assign the accumulated string of digits to the resut of the function.
Hence, n will get the first string of digits in the file; the next character has been read,and we know it isn't a digit (otherwise it would have been appended to the string returned).
We then repeat the process with n2. All of the remaining characters before then next digit are skipped, the digit sequence returned and the following character placed in ch
Then we assign the resullt of converting the string n to an integer to m. You haven't described what the other number may be used for, so it's there - but unused.
Set up the two arays, a and e.
Then use the same routine to read the next integer. It doesn't matter that there are CRLF characters - we skip to the next numeric and return it. and repeat that for the second number in the line.
Convert the two numbers and put them into their respective arrays.
Do this m times.
inally, write a new line to the display, then another reporting Results and then repeat m times write a line containing the iteration number i and the values of the two arrays, a and e, all as integers-converted-to-strings and with = and , characters to show that we're not just repeating the dat read from the input.
Finally, wait for an input from the keyboard (since the readln has no explicit filevar) which holds the program open until we can see the results.
Now - nominally, of course, you should also close the file before terminating...

How can I measure the difference of speed of code between loop and recursive method?

Let's say we have to create a calculator, and the first function it has is Fatorial.
We can write it as a recursive function or use a loop to get the result.
We all know that recursion is more slow because of it's exponential nature.
But how to prove it by code and not by counting lines?
I have tried to calculate the amount of milliseconds spent, but with my i7 it is always zero between the initial time and when the code stops.
How can I measure the difference of speed of code between loop and recursive method?
type
TJanela = class(TForm)
Instrucao: TLabel;
Entrada: TEdit;
Botao: TButton;
procedure Calcular(Sender: TObject);
end;
var
Janela: TJanela;
Val, Fat, Start, TimeRecursive, TimeLoop: Int64;
function FR(N: Int64): Int64; // Fatorial Recursivo
function FL(N: Int64): Int64; // Fatorial em Loop
implementation
{$R *.dfm}
procedure TJanela.Calcular(Sender: TObject);
begin
Val := StrToInt(Entrada.Text);
Start := StrToInt(FormatDateTime('nnsszzz',Now));
Fat := FR(Valor);
TimeRecursive := StrToInt(FormatDateTime('nnsszzz',Now)) - Start;
Start := StrToInt(FormatDateTime('nnsszzz',Now));
Fat := FL(Valor);
TimeLoop := StrToInt(FormatDateTime('nnsszzz',Now)) - Start;
if Val > 25 then
ShowMessage('Delphi can't calculate above [ 25! ]')
else
ShowMessage(' [ ' +
IntToStr(Val) + '! ] is equal to [ ' +
FormatFloat('###,###,###,###,###,###',Fat) + ' ]'#13#13+
'Recursive: [ ' + IntToStr(TimeRecursive) + ' ] ms;'#13+
'Loop: [ ' + IntToStr(TimeLoop) + ' ] ms;');
end;
function FR(N: Int64): Int64;
begin
if N <= 1 then
Result := 1
else
Result := N * FR(N - 1);
end;
function FL(N: Int64): Int64;
var
I: Integer;
begin
for I := 2 to N - 1 do
N := N * I;
if N = 0 then
Result := 1
else
Result := N;
end;
Now that David came with the answer, I asked a question on Mathematics so they can help me to come out with two equations to determine the proximate time a given factorial will spend on the computer in both methods.
You are using quite a low resolution timer and a single evaluation of the factorial function is too fast to even register.
You could use a higher resolution timer, but by far the easiest approach is to time something that takes longer. Instead of timing a single call to factorial, time a thousand, or a million.
If you are actually interested in implementing a fast factorial function, for integer inputs, then you should use a lookup table.
For what it is worth, I think that TStopWatch in the Diagnostics unit is more convenient for timing than the date/time functions.
Use a profiler. Recent versions of Delphi include limited functionality versions of AQTime, but a search for profiler Delphi here turns up Profiler and Memory Analysis Tools for Delphi here at StackOverflow.
Profilers allow you to evaluate your code in several different ways, including the precise amount of time spent executing various parts of it. You can use the results to determine which takes more (or less) time.
if its just for testing, could you put a TimeGetTime() instead of GetTime() before the loop and one after. then just save the value in a list box to see how long it takes.
if that is too slow try QueryPerformanceCounter/QueryPerformanceFrequency

Resources