Most repeated character in a row - pascal

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.

Related

Insertion Sort - TStringList Delphi

i'm trying to sort TStringList of integers from a text file with Insertion and Selection Sort .Selection Sort works ok , but the Insertion Sort doesnt work with my code . Can someone tell me where i'm wrong ? My 'numbers.txt' has 5000 lines of numbers. Thanks in advance
UPDATE : I have edited my code a bit , it works now with Insertion-Sort but it sorts just 4 indexes of integer as on the image
var
i, Position, n: integer;
Value: string;
begin
n := Items.Count;
for i := 1 to n - 1 do
begin
Value := Items[i];
Position := i-1;
while (Position >0) and (Items[Position]>Value) do
begin
Items[Position+1]:= Items[Position] ;
Position := Position -1 ;
end;
Items[Position+1] := Value;
end;
end;
Your data in the image is sorting exactly as it should, because you're sorting on string values, and based on the comparison you're making the order is perfect. "1143" falls exactly between the string values "11413" and "11443", because the comparison is made character by character out to the length of the shortest of the values. "1141" < "1143" < "1144", based on the first four characters of each string.
If you want an actual integer sort, then you need to convert the two values to integer before comparing them. Something like this should work (note I did not test your overall sort logic - I just used values that demonstrate the concept):
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.Classes;
var
i, Position, n: integer;
Value: integer;
Items: TStringList;
begin
Items := TStringList.Create;
try
Items.DelimitedText := '1116,11170,11178,11206,1122,11221,11228';
n := Items.Count;
for i := 1 to n - 1 do
begin
Value := StrToInt(Items[i]);
Position := i - 1;
while (Position > 0) and (StrToInt(Items[Position]) > Value) do
begin
Items[Position + 1]:= Items[Position];
Position := Position - 1 ;
end;
Items[Position+1] := IntToStr(Value);
end;
for i := 0 to Items.Count - 1 do
WriteLn(Items[i]);
finally
Items.Free;
end;
ReadLn;
end.
The output I got from the code above in a console window:
1116
1122
11170
11178
11206
11221
11228

Pascal, reading unknown number of integers

My question is how can I read some number of integers that user enters on standard input, and place them in array.However I don't how many numbers user will enter and i can't ask him that? User enters numbers in one line.
Okay i have just one more answer i would like to add.Thanks all for your help this is code written based on suggestions.I added a line for writting array backwards just for you can see that it has readed well.
program backo;
var niz:array [1..100] of integer;
n, i:integer;
begin
i:=1;
writeln('enter elements of array');
read(niz[i]);
while not eoln do
begin
i:=i+1;
read(niz[i]);
end;
for n:=i downto 1 do
writeln(niz[n]);
end.
Ok, based on comments there is three ways demonstrated:
program readmultiint;
{$mode objfpc}{$H+}
uses
StrUtils;
const
CMaxValues = 3;
var
s: string;
darr: array of Integer;
sarr: array [0..CMaxValues-1] of Integer;
i, cnt: Integer;
begin
// Dynamic array using WordCount
Writeln('Enter values:');
Readln(s);
cnt := WordCount(s, StdWordDelims);
SetLength(darr, cnt); // Allocate room for values
for i := 0 to cnt - 1 do
Val(ExtractWord(i + 1, s, StdWordDelims), darr[i]);
for i in darr do
Writeln(i);
// Dynamic array usin EOLN
SetLength(darr, 0);
Writeln('Enter values:');
while not eoln do
begin
SetLength(darr, Length(darr) + 1); // Expand array for next value
Read(darr[High(darr)]);
end;
Readln; // Read <Enter> itself
for i in darr do
Writeln(i);
// Static array
cnt := 0;
Writeln('Enter values:');
while (not eoln) and (cnt < CMaxValues) do // Reads not more then CMaxValues values
begin
Read(sarr[cnt]);
Inc(cnt);
end;
Readln; // Read <Enter> itself
for i := 0 to cnt-1 do
Writeln(sarr[i]);
end.
Feel free to use one of them or provide your own :)
PS: Some readings:
Dynamic arrays
Val procedure
for-in loop

TPascal, Stack Overflow, Recursion

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 :-)

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 many times does one number divide into another, and how much is left over?

I need an algorithm in Delphi to generate partitions for a specified integer value.
Example: for 13 if 5 is specified as the max value for partition it will give 5,5,3; if 4 is specified as max partition value the result should be 4,4,4,1, and so on.
It's simple enough to solve the problem using div and mod. Here's an example program that I don't think needs any further explanation:
program IntegerPartitions;
{$APPTYPE CONSOLE}
function Partitions(const Total, Part: Integer): TArray<Integer>;
var
Count: Integer;
Rem: Integer;
i: Integer;
begin
Assert(Total>0);
Assert(Part>0);
Count := Total div Part;
Rem := Total mod Part;
if Rem=0 then
SetLength(Result, Count)
else
SetLength(Result, Count+1);
for i := 0 to Count-1 do
Result[i] := Part;
if Rem<>0 then
Result[Count] := Rem;
end;
var
Value: Integer;
begin
for Value in Partitions(13, 5) do
Writeln(Value);
Readln;
end.

Resources