How do I expand string of text?
I need to turn e. g. string which is 'abcde' into newstring, 'abcdeabcdeabcd', so length(newstring) is equal to length(someotherstring). Main purpose - generating keys for the Vigenere's encryption algorithm.
The following function expands a string by repeating its characters:
function RepeatString(const AText: string; ANewLength: Integer): string;
var
i: Integer;
begin
if ANewLength <= Length(AText) then
begin
Result := Copy(AText, 1, ANewLength);
Exit;
end;
SetLength(Result, ANewLength);
for i := 1 to Length(Result) do
Result[i] := AText[(i - 1) mod Length(AText) + 1];
end;
If you are using a modern Delphi version of Pascal, this can be written more neatly:
function RepeatString(const AText: string; ANewLength: Integer): string;
var
i: Integer;
begin
if ANewLength <= AText.Length then
Exit(Copy(AText, 1, ANewLength));
SetLength(Result, ANewLength);
for i := 1 to Result.Length do
Result[i] := AText[(i - 1) mod AText.Length + 1];
end;
There is a "but"
However, in your case (implementing the Vigenère cipher), it is a bad idea to use such a function. You don't need it, so you will only waste memory (and CPU usage) creating this extended version of the string.
Instead, use the original string. Instead of using chars 1, 2, 3, 4, 5, 6, 7, ... of an extended version of the string, use chars 1, 2, 3, 1, 2, 3, 1, ... of the original string.
Something like this (haven't tested fully):
function Vigenere(const AText, AKey: string): string;
var
KeyChrs: array of Byte;
n, i: Integer;
begin
n := Length(AKey);
if n = 0 then
raise Exception.Create('Vigenère key is empty.');
SetLength(KeyChrs, n);
for i := 1 to n do
if InRange(Ord(AKey[i]), Ord('A'), Ord('Z')) then
KeyChrs[i - 1] := Ord(AKey[i]) - Ord('A')
else
raise Exception.Create('Invalid character in Vigenère key. Only upper-case English letters allowed.');
SetLength(Result, Length(AText));
for i := 1 to Length(AText) do
if InRange(Ord(AText[i]), Ord('A'), Ord('Z')) then
Result[i] := Chr(Ord('A') + (Ord(AText[i]) - Ord('A') + KeyChrs[(i - 1) mod n]) mod 26)
else if InRange(Ord(AText[i]), Ord('a'), Ord('z')) then
Result[i] := Chr(Ord('a') + (Ord(AText[i]) - Ord('a') + KeyChrs[(i - 1) mod n]) mod 26)
else
Result[i] := AText[i];
end;
If you are using Lazarus or Free Pascal, use strutils.dupestring like this:
newstr:=dupestring(oldstr,4); // concatenates oldstr 4 times into dupestring
// If you need to remove n chars from the last pattern (in your example n=1), use
setlength(newstr,length(newstr)-n);
Related
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:
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.
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)
Before i must say this : Please, excuse me for my bad english...
I'm student.My teacher gave me problem in pascal for my course work...
I must write program that calculates 2^n for big values of n...I've wrote but there is a problem...My program returns 0 for values of n that bigger than 30...My code is below...Please help me:::Thanks beforehand...
function control(a: integer): boolean;
var
b: boolean;
begin
if (a >= 10) then b := true
else b := false;
control := b;
end;
const
n = 200000000;
var
a: array[1..n] of integer;
i, j, c, t, rsayi: longint; k: string;
begin
writeln('2^n');
write('n=');
read(k);
a[1] := 1;
rsayi := 1;
val(k, t, c);
for i := 1 to t do
for j := 1 to t div 2 do
begin
a[j] := a[j] * 2;
end;
for i := 1 to t div 2 do
begin
if control(a[j]) = true then
begin
a[j + 1] := a[j + 1] + (a[j] div 10);
a[j] := a[j] mod 10;
rsayi := rsayi + 1;
end;
end;
for j := rsayi downto 1 do write(a[j]);
end.
The first (nested) loop boils down to "t" multiplications by 2 on every single element of a.
30 multiplications by two is as far as you can go with a 32-bit integer (2^31-1 of positive values, so 2^31 is out of reach)
So the first loop doesn't work, and you probably have to rethink your strategy.
Here is a quick and dirty program to compute all 2^n up to some given, possibly large, n. The program repeatedly doubles the number in array a, which is stored in base 10; with lower digit in a[1]. Notice it's not particularly fast, so it would not be wise to use it for n = 200000000.
program powers;
const
n = 2000; { largest power to compute }
m = 700; { length of array, should be at least log(2)*n }
var
a: array[1 .. m] of integer;
carry, s, p, i, j: integer;
begin
p := 1;
a[1] := 1;
for i := 1 to n do
begin
carry := 0;
for j := 1 to p do
begin
s := 2*a[j] + carry;
if s >= 10 then
begin
carry := 1;
a[j] := s - 10
end
else
begin
carry := 0;
a[j] := s
end
end;
if carry > 0 then
begin
p := p + 1;
a[p] := 1
end;
write(i, ': ');
for j := p downto 1 do
write(a[j]);
writeln
end
end.
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
We don’t allow questions seeking recommendations for books, tools, software libraries, and more. You can edit the question so it can be answered with facts and citations.
Closed 4 years ago.
Improve this question
Duplicate
Best algorithm for evaluating a mathematical expression?
Is there a built-in Delphi function which would convert a string such as '2*x+power(x,2)' or any equation to float? StrToFloat raises an exception because of the char X and power.
Thanks.
The free JCL includes TEvaluator, a parser written by one of the current Delphi compiler engineers. It will likely be far more efficient than an expression evaluator based on Windows Script Host.
Long ago (iirc 2005), some SIG did an comparison of various expression parsers. The results are at:
http://www.mindspring.com/~rbwinston/ParserTestFiles.zip
including the classic Turbo Pascal one by Renate Schaaf.
In general, the faster ones generate native code, but are unportable, and might need fixing for DEP etc.
Writing a basic one yourself isn't that hard, and a standard task in many programming courses. I wrote one in FPC/Delphi (now part of the freepascal distribution as "Symbolic") and converted it later to Java (as an exercise in Java string handling. I still wake up screaming at night sometimes).
Its SVN location is
http://svn.freepascal.org/cgi-bin/viewvc.cgi/trunk/packages/symbolic/
Note to self: I still have some unfinished code somewhere to add user definable functions and boolean arithmetic. Must finish it someday :-)
You are looking for something that can evaluate an expression.
Since Delphi is a compiled language, it does not have built-in support for that.
However, there are external tools that can help you with that.
For instance: the Free Pascal Scripting engine from RemObjects can do what you want.
--jeroen
No, it's impossible except of parsing string. And how can you convert unknown number x to float?
In our SMImport suite we wrote the own expression parser/evaluator which is based on original TFatExpression component by Gasper Kozak, gasper.kozak#email.si
Works very good.
You can use my unit, its still basic but im still writing it, it does basic bodmas right now but i will post the whole unit when i am done
Unit BODMAS;
Interface
Uses
System.SysUtils,
Math;
{
!!!!!!!!!!!!!!!!!!!!!! GLOBAL DEFINITIONS !!!!!!!!!!!!!!!!!!!!
EXPR = EXPRESSION
CURRENTPOS = POSSITION OF THE CURRENT OPPERATOR OF WHICH MATH IS BEING PERFORMED
}
Function EvalFunction(Expr: String): String;
Implementation
Function PrevOppPos(Expr: String; CurrentPos: Integer): Integer; // GETS THE PREVIOUS OPPERATOR
Var
I: Integer;
bSet: Boolean;
Begin
// THEORY
// KEEP MOVING POSITIONS DOWN FROM I ... ( MEANING < WAY IN EXPR)
// UNTIL AN OPPERATOR IS FOUND. IF NO OPPERATOR IS FOUND THE RESULT
// WILL BE THE BEGINING OF THE EXPRESSION
I := CurrentPos - 1;
bSet := False;
While ((I <= CurrentPos) AND (I >= 1)) OR (bSet = False) Do
Begin
// CHECK IF THE CHACHARACTER OF POSITION I IN EXPR IS AN OPPERATOR
// "." AND "," IS NOT AN OPPERATOR!!
If Expr[I] In ['(', ')', '+', '-', 'x', '/'] Then
Begin
Result := I;
bSet := True;
Dec(I); // Dec 1 more time to break loop
End;
Dec(I);
If (I = 0) AND (NOT(bSet)) Then
Begin
Result := 1;
bSet := True;
End;
End;
End;
Function NextOppPos(Expr: String; CurrentPos: Integer): Integer;
Var
I: Integer;
bSet: Boolean;
Begin
// THEORY
// KEEP MOVING POSITIONS UP FROM I ... ( MEANING > WAY IN EXPR)
// UNTIL AN OPPERATOR IS FOUND. IF NO OPPERATOR IS FOUND THE RESULT
// WILL BE THE LENGHT OF THE EXPRESSION
I := CurrentPos + 1;
bSet := False;
While ((I <= Length(Expr)) AND (I >= CurrentPos)) OR (bSet = False) Do
Begin
// CHECK IF THE CHACHARACTER OF POSITION I IN EXPR IS AN OPPERATOR
// "." AND "," IS NOT AN OPPERATOR!!
If Expr[I] In ['(', ')', '+', '-', 'x', '/'] Then
Begin
Result := I;
bSet := True;
Inc(I); // Inc 1 more time to break loop
End;
Inc(I);
If (I = Length(Expr) + 1) AND (NOT(bSet)) Then
Begin
Result := Length(Expr);
bSet := True;
End;
End;
End;
// EVALUATE BRACKET EXPRESSION
Function EvalBracetExpr(Expr: String): String;
Var
OppCount, I: Integer;
Ans: String;
NewExpr: String;
nOpp, pOpp, OppPos: Integer;
nExpr, pExpr: String;
Begin
Ans := '';
// EVALUATE EXPRESSION
// ALL MULTIPLICATION IN BRACKETS
While Pos('x', Expr) <> 0 Do
Begin
OppPos := Pos('x', Expr); // Opperator Position
nOpp := NextOppPos(Expr, OppPos); // Next Opperator Position
pOpp := PrevOppPos(Expr, OppPos); // Previous Opperator Position
// COPY FROM THE OPPERATOR POS TO THE LENGTH OF THE EXPRESSION - THE POSITION OF THE NEXT EXPRESSION
// When Next opperator is the length of the expression
If nOpp = Length(Expr) Then
nExpr := Copy(Expr, OppPos + 1, Length(Expr) - (Length(Expr) - 1))
Else
nExpr := Copy(Expr, OppPos + 1, Length(Expr) - nOpp);
// COPY FROM THE PREVIOUS OPPERATOR POS TO THE OPPERATOR POSITION -1
pExpr := Copy(Expr, pOpp + 1, (OppPos - 1) - pOpp);
Delete(Expr, pOpp, nOpp);
Ans := Ans + FloatToStr(StrToFloat(pExpr) * StrToFloat(nExpr));
End;
// ALL ADDITION IN BRACKETS
While Pos('+', Expr) <> 0 Do
Begin
OppPos := Pos('+', Expr); // Opperator Position
nOpp := NextOppPos(Expr, OppPos); // Next Opperator Position
pOpp := PrevOppPos(Expr, OppPos); // Previous Opperator Position
// COPY FROM THE OPPERATOR POS TO THE LENGTH OF THE EXPRESSION - THE POSITION OF THE NEXT EXPRESSION
// When Next opperator is the length of the expression
If nOpp = Length(Expr) Then
nExpr := Copy(Expr, OppPos + 1, Length(Expr) - (Length(Expr) - 1))
Else
nExpr := Copy(Expr, OppPos + 1, Length(Expr) - nOpp - 1);
// COPY FROM THE PREVIOUS OPPERATOR POS TO THE OPPERATOR POSITION -1
pExpr := Copy(Expr, pOpp + 1, (OppPos - 1) - pOpp);
Delete(Expr, pOpp, nOpp);
Ans := Ans + FloatToStr(StrToFloat(pExpr) + StrToFloat(nExpr));
End;
Result := Ans;
End;
// EVALUTE ADDITION EXPRESSION
Function EvalAddExpr(Expr: String): String;
Var
Expr1, Expr2: String;
Begin
Expr1 := Copy(Expr, 1, Pos('+', Expr) - 1);
Expr2 := Copy(Expr, Pos('+', Expr) + 1, Length(Expr));
Result := FloatToStr(StrToFloat(Expr1) + StrToFloat(Expr2));
End;
Function EvalFunction(Expr: String): String;
Var
bOPos, bCPos: Integer; // bracket Open/Closed Position
sExpr: String;
FinalExpr: String;
OppPos: Integer;
PrevOpp, NextOpp: Integer;
Begin
While Pos('(', Expr) <> 0 Do
Begin
// Find first open bracket
bOPos := Pos('(', Expr);
// Find first closed bracket
bCPos := Pos(')', Expr);
// Get the expression between the 2 brackets
sExpr := Copy(Expr, bOPos, bCPos);
// Remove sExpr from the Expression
Delete(Expr, bOPos, bCPos + 1 - bOPos);
// Concatenate the expression of what was before the bracket and that after the bracket, as well as the result in the middle
FinalExpr := Copy(Expr, 1, bOPos - 1) + EvalBracetExpr(sExpr) + Copy(Expr, bOPos, Length(Expr));
// Return the result
Expr := FinalExpr;
End;
While Pos('+', Expr) <> 0 Do
Begin
// 1) Find the first + opperator in expression
OppPos := Pos('+', Expr);
// 2) find first part of expression
PrevOpp := PrevOppPos(Expr, OppPos);
// 3) find the next part of the expression
NextOpp := NextOppPos(Expr, OppPos);
// 4) get the full expression between the opperators
//
// if prev opp <> 1 then
// move indicator 1 pos ahead
If PrevOpp <> 1 Then
Inc(PrevOpp);
// if next opp <> len of expr then
// move indicator 1 pos back
If NextOpp <> Length(Expr) Then
Dec(NextOpp);
sExpr := Copy(Expr, PrevOpp, NextOpp);
// 5) evaluating expression
Delete(Expr, PrevOpp, NextOpp);
FinalExpr := Copy(Expr, 1, PrevOpp-1) + EvalAddExpr(sExpr) + Copy(Expr, PrevOpp, Length(Expr));
End;
Result := Expr;
End;
End.
you will use the EvalFunction to return results