Read integers from a string - algorithm

I'm learning algorithms and I'm trying to make an algorithm that extracts numbers lets say n in [1..100] from a string. Hopefully I get an easier algorithm.
I tried the following :
procedure ReadQuery(var t : tab); // t is an array of Integer.
var
x,v,e : Integer;
inputs : String;
begin
//readln(inputs);
inputs:='1 2 3';
j:= 1;
// make sure that there is one space between two integers
repeat
x:= pos(' ', inputs); // position of the space
delete(inputs, x, 1)
until (x = 0);
x:= pos(' ', inputs); // position of the space
while x <> 0 do
begin
x:= pos(' ', inputs); //(1) '1_2_3' (2) '2_3'
val(copy(inputs, 1, x-1), v, e); // v = value | e = error pos
t[j]:=v;
delete(inputs, 1, x); //(1) '2_3' (2) '3'
j:=j+1; //(1) j = 2 (2) j = 3
//writeln(v);
end;
//j:=j+1; // <--- The mistake were simply here.
val(inputs, v, e);
t[j]:=v;
//writeln(v);
end;
I get this result ( resolved ) :
1
2
0
3
expected :
1
2
3
PS : I'm not very advanced, so excuse me for reducing you to basics.
Thanks for everyone who is trying to share knowledge.

Your code is rather inefficient and it also doesn't work for strings containing numbers in general.
A standard and performant approach would be like this:
type
TIntArr = array of Integer;
function GetNumbers(const S: string): TIntArr;
const
AllocStep = 1024;
Digits = ['0'..'9'];
var
i: Integer;
InNumber: Boolean;
NumStartPos: Integer;
NumCount: Integer;
procedure Add(Value: Integer);
begin
if NumCount = Length(Result) then
SetLength(Result, Length(Result) + AllocStep);
Result[NumCount] := Value;
Inc(NumCount);
end;
begin
InNumber := False;
NumCount := 0;
for i := 1 to S.Length do
if not InNumber then
begin
if S[i] in Digits then
begin
NumStartPos := i;
InNumber := True;
end;
end
else
begin
if not (S[i] in Digits) then
begin
Add(StrToInt(Copy(S, NumStartPos, i - NumStartPos)));
InNumber := False;
end;
end;
if InNumber then
Add(StrToInt(Copy(S, NumStartPos)));
SetLength(Result, NumCount);
end;
This code is intentionally written in a somewhat old-fashioned Pascal way. If you are using a modern version of Delphi, you wouldn't write it like this. (Instead, you'd use a TList<Integer> and make a few other adjustments.)
Try with the following inputs:
521 cats, 432 dogs, and 1487 rabbits
1 2 3 4 5000 star 6000
alpha1beta2gamma3delta
a1024b2048cdef32
a1b2c3
32h50s
5020
012 123!
horses
(empty string)
Make sure you fully understand the algorithm! Run it on paper a few times, line by line.

Related

Limiting Ord to letters only

I'm trying to create a simple Crypting method for a school project, the idea is to change a character by increasing it's ascii with a user entered number then replacing it back.
So my problem is when I do it, it works, but it also includes symboles like %$! ...etc.
What I want to do is to limit the Ord function to letters only, For example if the user entered the number 100 but there's only 26 letters in the alphabet, it will keep looping over and over through that 26 till it reaches the 100th.
Hope I'm clear enough lol
Here's what I have so far, a part of a whole code:
Procedure Crypting( Var cryptFile : Text; tempVar2 : String; pNumber: Integer);
Begin
Writeln('Enter P : ');
Readln(P);
Reset( cryptFile );
For i:= 1 to length(tempVar2) do
Write(Chr(Ord(tempVar2[i])+P));
End;
It seems like you are looking to implement the Caesar cipher.
First, you need to use an if statement to check if the current character is a letter or not. If so, you transform it; if not, you leave it as it is.
Second, it is not enough to simply add P to the character code. Although it works for A and P = 3, producing D, what will happen for Y and P = 3? You need to use modular arithmetic so you get Y → Z → A → B.
Third, in programming, it is important to structure your code well and refactor it properly. Currently, you mix input and transformation. You should keep these separate. If you create a Caesar function, you can use it every time you need to perform the Caesar cipher.
If we also need to support both capital and small letters, it is better to use a case construct instead of an if .. else if .. else construct.
Putting it all together:
function Caesar(const S: string; N: Integer): string; // slow
var
i: Integer;
begin
Result := '';
for i := 1 to Length(S) do
case S[i] of
'A'..'Z':
Result := Result + Chr(Ord('A') + (Ord(S[i]) - Ord('A') + N) mod 26);
'a'..'z':
Result := Result + Chr(Ord('a') + (Ord(S[i]) - Ord('a') + N) mod 26);
else
Result := Result + S[i];
end;
end;
This function works, but is not optimal from a performance point of view, since you need a heap allocation for every iteration. It is better to allocate the result string once and then only fill it:
function Caesar(const S: string; N: Integer): string;
var
i: Integer;
begin
SetLength(Result, Length(S));
for i := 1 to Length(S) do
case S[i] of
'A'..'Z':
Result[i] := Chr(Ord('A') + (Ord(S[i]) - Ord('A') + N) mod 26);
'a'..'z':
Result[i] := Chr(Ord('a') + (Ord(S[i]) - Ord('a') + N) mod 26);
else
Result[i] := S[i];
end;
end;
A complete example:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
function Caesar(const S: string; N: Integer): string;
var
i: Integer;
begin
SetLength(Result, Length(S));
for i := 1 to Length(S) do
case S[i] of
'A'..'Z':
Result[i] := Chr(Ord('A') + (Ord(S[i]) - Ord('A') + N) mod 26);
'a'..'z':
Result[i] := Chr(Ord('a') + (Ord(S[i]) - Ord('a') + N) mod 26);
else
Result[i] := S[i];
end;
end;
var
s: string;
N: Integer;
begin
Writeln('Please enter a string to transform:');
Readln(s);
Writeln('Please enter shift size:');
Readln(N);
Writeln;
Writeln('Result: ', Caesar(s, N));
Writeln;
Writeln('Thank you for using this program! Have a nice day!');
Writeln('Press Return to exit.');
Readln;
end.
(The precise program structure depends on the kind of Pascal you are using -- there are many different kinds of Pascal.)
Screenshot:

A game with 100 oponnents, win as much money as possible

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

Check if bracket order is valid

what I am trying to do, is determine, whether brackets are in correct order. For example ([][[]]<<>>) is vallid, but ][]<<(>>) is not.
I got a working version, but it has terrible efficiency and when it gets 1000+ brackets, its just crazy slow. I was hoping someone might suggest some possible improvements or another way to do it.
Here is my code:
program Codex;
const
C_FNAME = 'zavorky.in';
var TmpChar : char;
leftBrackets, rightBrackets : string;
bracketPos : integer;
i,i2,i3 : integer;
Arr, empty : array [0..10000] of String[2];
tfIn : Text;
result : boolean;
begin
leftBrackets := ' ( [ /* ($ <! << ';
rightBrackets := ' ) ] */ $) !> >> ';
i := 0;
result := true;
Assign(tfIn, C_FNAME);
Reset(tfIn);
{ load data into array }
while not eof(tfIn) do
begin
while not eoln(tfIn) do
begin
read(tfIn, TmpChar);
if (TmpChar <> ' ') then begin
if (TmpChar <> '') then begin
Arr[i] := Arr[i] + TmpChar;
end
end
else
begin
i := i + 1;
end
end;
i2 := -1;
while (i2 < 10000) do begin
i2 := i2 + 1;
{if (i2 = 0) then
writeln('STARTED LOOP!');}
if (Arr[i2] <> '') then begin
bracketPos := Pos(' ' + Arr[i2] + ' ',rightBrackets);
if (bracketPos > 0) then begin
if (i2 > 0) then begin
if(bracketPos = Pos(' ' + Arr[i2-1] + ' ',leftBrackets)) then begin
{write(Arr[i2-1] + ' and ' + Arr[i2] + ' - MATCH ');}
Arr[i2-1] := '';
Arr[i2] := '';
{ reindex our array }
for i3 := i2 to 10000 - 2 do begin
Arr[i3 - 1] := Arr[i3+1];
end;
i2 := -1;
end;
end;
end;
end;
end;
{writeln('RESULT: ');}
For i2:=0 to 10 do begin
if (Arr[i2] <> '') then begin
{write(Arr[i2]);}
result := false;
end;
{else
write('M');}
end;
if (result = true) then begin
writeln('true');
end
else begin
writeln('false');
end;
result := true;
{ move to next row in file }
Arr := empty;
i := 0;
readln(tfIn);
end;
Close(tfIn);
readln;
end.
The input data in the file zavorky.in look for example like this:
<< $) >> << >> ($ $) [ ] <! ( ) !>
( ) /* << /* [ ] */ >> <! !> */
I determine for each row whether it is valid or not. Max number of brackets on a row is 10000.
You read chars from your file. File read in byte-by-byte mode is very slow. You need to optimize the way to read the strings (buffers) instead or load the file in memory first.
Hereunder I propose the other way to process the fetched string.
First I declare the consts that will state the brackets that you might have:
const
OBr: array [1 .. 5{6}] of string = ('(', '[', '/*', '<!', '<<'{, 'begin'});
CBr: array [11 .. 15{16}] of string = (')', ']', '*/', '!>', '>>'{, 'end'});
I decided to do this as now you are not limited to the length of the brackets expression and/or number of brackets' types. Every closing and corresponding opening bracket has index difference equal to 10.
And here is the code for the function:
function ExpressionIsValid(const InputStr: string): boolean;
var
BracketsArray: array of byte;
i, Offset, CurrPos: word;
Stack: array of byte;
begin
result := false;
Setlength(BracketsArray, Length(InputStr) + 1);
for i := 0 to High(BracketsArray) do
BracketsArray[i] := 0; // initialize the pos array
for i := Low(OBr) to High(OBr) do
begin
Offset := 1;
Repeat
CurrPos := Pos(OBr[i], InputStr, Offset);
if CurrPos > 0 then
begin
BracketsArray[CurrPos] := i;
Offset := CurrPos + 1;
end;
Until CurrPos = 0;
end; // insert the positions of the opening brackets
for i := Low(CBr) to High(CBr) do
begin
Offset := 1;
Repeat
CurrPos := Pos(CBr[i], InputStr, Offset);
if CurrPos > 0 then
begin
BracketsArray[CurrPos] := i;
Offset := CurrPos + 1;
end;
Until CurrPos = 0;
end; // insert the positions of the closing brackets
Setlength(Stack, 0); // initialize the stack to push/pop the last bracket
for i := 0 to High(BracketsArray) do
case BracketsArray[i] of
Low(OBr) .. High(OBr):
begin
Setlength(Stack, Length(Stack) + 1);
Stack[High(Stack)] := BracketsArray[i];
end; // there is an opening bracket
Low(CBr) .. High(CBr):
begin
if Length(Stack) = 0 then
exit(false); // we can not begin an expression with Closing bracket
if Stack[High(Stack)] <> BracketsArray[i] - 10 then
exit(false) // here we do check if the previous bracket suits the
// closing bracket
else
Setlength(Stack, Length(Stack) - 1); // remove the last opening
// bracket from stack
end;
end;
if Length(Stack) = 0 then
result := true;
end;
Perhaps, we do an extra work by creating a byte array, but it seems that this method is i) more easy to understand and ii) is flexible as we can change the length of brackets expressions for example use and check begin/end brackets etc.
Appended
As soon as I see that the major problem is in organizing block reading of file I give here an idea of how to do it:
procedure BlckRead;
var
f: file;
pc, pline: { PChar } PAnsiChar;
Ch: { Char } AnsiChar;
LngthLine, LngthPc: word;
begin
AssignFile(f, 'b:\br.txt'); //open the file
Reset(f, 1);
GetMem(pc, FileSize(f) + 1); //initialize memory blocks
inc(pc, FileSize(f)); //null terminate the string
pc^ := #0;
dec(pc, FileSize(f)); //return the pointer to the beginning of the block
GetMem(pline, FileSize(f)); //not optimal, but here is just an idea.
pline^ := #0;//set termination => length=0
BlockRead(f, pc^, FileSize(f)); // read the whole file
//you can optimize that if you wish,
//add exception catchers etc.
LngthLine := 0; // current pointers' offsets
LngthPc := 0;
repeat
repeat
Ch := pc^;
if (Ch <> #$D) and (Ch <> #$A) and (Ch <> #$0) then
begin // if the symbol is not string-terminating then we append it to pc
pline^ := Ch;
inc(pline);
inc(pc);
inc(LngthPc);
inc(LngthLine);
end
else
begin //otherwise we terminate pc with Chr($0);
pline^ := #0;
inc(LngthPc);
if LngthPc < FileSize(f) then
inc(pc);
end;
until (Ch = Chr($D)) or (Ch = Chr($A)) or (Ch = Chr($0)) or
(LngthPc = FileSize(f));
dec(pline, LngthLine);
if LngthLine > 0 then //or do other outputs
Showmessage(pline + #13#10 + Booltostr(ExpressionIsValid(pline), true));
pline^ := #0; //actually can be skipped but you know your file structure better
LngthLine := 0;
until LngthPc = FileSize(f);
FreeMem(pline); //free the blocks and close the file
dec(pc, FileSize(f) - 1);
FreeMem(pc);
CloseFile(f);
end;
You are saving all the data into memory (even couple of times) and then you have a lot of checks. I think you are on the right track but there are much easier steps you could follow.
Make an array of integers (default = 0) with length the number of brackets you have (e.g. ' ( [ /* ($ <! << ' ==> 6)
Now to make sure that you are following the requirements. Read the file line by line and take into account only the first 10000. This could help.
Every time you find an element from the first array (e.g. leftBrackets) add +1 to the value of the coresponding index of the array of step 1. Example would be:
'[' ==> checkArray[1] += 1
Do the same for rightBrackets but this time check if the value is larger than 0. If yes then subtract 1 the same way (e.g. ']' ==> checkArray[1] -= 1) otherwise you just found invalid bracket
I hope this helps and Good luck.
I think the following should work, and will be order O(n), where n is the length of the string. First build two function.
IsLeft(bra : TBracket) can determine if a bracket is a left bracket or a right bracket, so IsLeft('<') = TRUE, IsLeft('>>') = FALSE.
IsMatchingPair(bra, ket : TBracket) can determine if two brackets are of the same 'type', so IsMatchingPair('(',')') =TRUE, but IsMatchingPair('{','>>') = FALSE.
Then build a stack TBracketStack with three functions procedure Push(bra : TBracket), and function Pop : TBracket, and function IsEmpty : boolean.
Now the following algorithm should work (with a little extra code required to ensure you don't fall off the end of the string unexpectedly):
BracketError := FALSE;
while StillBracketsToProcess(BracketString) and not BracketError do
begin
bra := GetNextBracket(BracketString);
if IsLeft(bra) then
Stack.Push(bra)
else
BracketError := Stack.IsEmpty or not IsMatchingPair(Stack.Pop,bra)
end;

All sums of a number

I need an algorithm to print all possible sums of a number (partitions).
For example: for 5 I want to print:
1+1+1+1+1
1+1+1+2
1+1+3
1+2+2
1+4
2+3
5
I am writing my code in Pascal. So far I have this:
Program Partition;
Var
pole :Array [0..100] of integer;
n :integer;
{functions and procedures}
function Minimum(a, b :integer): integer;
Begin
if (a > b) then Minimum := b
else Minimum := a;
End;
procedure Rozloz(cislo, i :integer);
Var
j, soucet :integer;
Begin
soucet := 0;
if (cislo = 0) then
begin
for j := i - 1 downto 1 do
begin
soucet := soucet + pole[j];
if (soucet <> n) then
Write(pole[j], '+')
else Write(pole[j]);
end;
soucet := 0;
Writeln()
end
else
begin
for j := 1 to Minimum(cislo, pole[i - 1]) do
begin
pole[i] := j;
Rozloz(cislo - j, i + 1);
end;
end;
End;
{functions and procedures}
{Main program}
Begin
Read(n);
pole[0] := 101;
Rozloz(n, 1);
Readln;
End.
It works good but instead of output I want I get this:
1+1+1+1+1
2+1+1+1
2+2+1
3+1+1
3+2
4+1
5
I can't figure out how to print it in right way. Thank you for help
EDIT: changing for j:=i-1 downto 1 to for j:=1 to i-1 solves one problem. But my output is still this: (1+1+1+1+1) (2+1+1+1) (2+2+1) (3+1+1) (3+2) (4+1) (5) but it should be: (1+1+1+1+1) (1+1+1+2) (1+1+3) (1+2+2) (1+4) (2+3) (5) Main problem is with the 5th and the 6th element. They should be in the opposite order.
I won't attempt Pascal, but here is pseudocode for a solution that prints things in the order that you want.
procedure print_partition(partition);
print "("
print partition.join("+")
print ") "
procedure finish_and_print_all_partitions(partition, i, n):
for j in (i..(n/2)):
partition.append(j)
finish_and_print_all_partitions(partition, j, n-j)
partition.pop()
partition.append(n)
print_partition(partition)
partition.pop()
procedure print_all_partitions(n):
finish_and_print_all_partitions([], 1, n)

Pascal Bubble Sort

I have a project where the program must accept 10 words and display the words in descending order (alphabetical order from Z-A)
using bubble sorting.
Here's what I know so far:
Program sample;
uses crt;
TYPE
no._list=ARRAY(1...10)OF REAL;
CONST
no.:no._list=(20.00,50.50.35.70....);
VAR
x:INTEGER;
small:REAL;
BEGIN clrscr:
small:=no.(1);
FOR x:=2 TO 10 DO
IF small>number(x);
writeln('Smallest value in the array of no.s is',small:7:2);
END
I really don't know how to do this though and could use some help.
Here's a video by Alister Christie on Bubble sort describing the principle :
http://codegearguru.com/index.php?option=com_content&task=view&id=64&Itemid=1
The algorithm in Pascal can be found # http://delphi.wikia.com/wiki/Bubble_sort
function BubbleSort( list: TStringList ): TStringList;
var
i, j: Integer;
temp: string;
begin
// bubble sort
for i := 0 to list.Count - 1 do begin
for j := 0 to ( list.Count - 1 ) - i do begin
// Condition to handle i=0 & j = 9. j+1 tries to access x[10] which
// is not there in zero based array
if ( j + 1 = list.Count ) then
continue;
if ( list.Strings[j] > list.Strings[j+1] ) then begin
temp := list.Strings[j];
list.Strings[j] := list.Strings[j+1];
list.Strings[j+1] := temp;
end; // endif
end; // endwhile
end; // endwhile
Result := list;
end;

Resources