I have a random string of numbers
(numbers can only be used once, only from 1-9, almost any length(min 1,max 9)):
var
Input: String;
begin
Input := '431829576'; //User inputs random numbers
And now I need to get specified number to front. How about 5.
var
Number: Integer;
begin
Number := 5;
and function executes with result 543182976.
I don't have any ideas how to make a function like this, Thanks.
Do you mean like this?
function ForceDigitInFront(const S: string; const Digit: Char): string;
begin
result := Digit + StringReplace(S, Digit, '', []);
end;
A more lightweight solution is
function ForceDigitInFront(const S: string; const Digit: Char): string;
var
i: Integer;
begin
result := S;
for i := 1 to Length(S) do
if result[i] = Digit then
begin
Delete(result, i, 1);
break;
end;
result := Digit + result;
end;
You could do it this way :
function ForceDigitInFront(const S: string; const Digit: Char): string;
var
dPos : Integer;
begin
Result := s;
dPos := Pos( Digit,S);
if (dPos <> 0) then begin // Only apply Digit in front if Digit exists !?
Delete( Result,dPos,1);
Result := Digit + Result;
end;
end;
If Digit is not in input string, the digit is not added here, but change this if it does not fit your implementation.
Here is a solution that reduces the numer of String allocations needed, as well as checks if the digit is already in the front:
function ForceDigitInFront(const S: string; const Digit: Char): string;
var
dPos : Integer;
begin
Result := s;
for dPos := 1 to Length(Result) do
begin
if Result[dPos] = Digit then
begin
if dPos > 1 then
begin
UniqueString(Result);
Move(Result[1], Result[2], (dPos-1) * SizeOf(Char));
Result[1] := Digit;
end;
Exit;
end;
end;
end;
Related
I have these three functions that successfully remove all non-numeric characters from a given string:
The first function loops through the characters of the input string, and if the current character is a number, it adds it to a new string that is returned as the result of the function.
function RemoveNonNumericChars(const s: string): string;
begin
Result := '';
for var i := 1 to Length(s) do
begin
if s[i] in ['0'..'9'] then
Result := Result + s[i];
end;
end;
The second function loops through the characters of the input string from right to left, and if the current character is not a number, it uses the Delete function to remove it from the string
function RemoveNonNumericChars(const s: string): string;
begin
Result := s;
for var i := Length(Result) downto 1 do
begin
if not(Result[i] in ['0'..'9']) then
Delete(Result, i, 1);
end;
end;
The third function uses a regular expression to replace all non-numeric characters with nothing, thus removing them. TRegEx is from the System.RegularExpressions unit.
function RemoveNonNumericChars(const s: string): string;
begin
var RegEx := TRegEx.Create('[^0-9]');
Result := RegEx.Replace(s, '');
end;
All three of them do what I need, but I want to know if there is maybe a built-in function in Delphi for this... Or maybe even a better way to do it than the way I'm doing it. What's the best and/or fastest way to remove non-numeric characters from a string in Delphi?
Both your approaches are slow because you constantly change the length of the string. Also, they only recognise Arabic digits.
To solve the performance issue, preallocate the maximum result length:
function RemoveNonDigits(const S: string): string;
begin
SetLength(Result, S.Length);
var LActualLength := 0;
for var i := 1 to S.Length do
if CharInSet(S[i], ['0'..'9']) then
begin
Inc(LActualLength);
Result[LActualLength] := S[i];
end;
SetLength(Result, LActualLength);
end;
To support non-Arabic digits, use the TCharacter.IsDigit function:
function RemoveNonDigits(const S: string): string;
begin
SetLength(Result, S.Length);
var LActualLength := 0;
for var i := 1 to S.Length do
if S[i].IsDigit then
begin
Inc(LActualLength);
Result[LActualLength] := S[i];
end;
SetLength(Result, LActualLength);
end;
To optimise even further, as suggested by Stefan Glienke, you can bypass the RTL's string handling machinery and write each character directly with some loss of code readability:
function RemoveNonDigits(const S: string): string;
begin
SetLength(Result, S.Length);
var ResChr := PChar(Result);
var LActualLength := 0;
for var i := 1 to S.Length do
if CharInSet(S[i], ['0'..'9']) then
begin
Inc(LActualLength);
ResChr^ := S[i];
Inc(ResChr);
end;
SetLength(Result, LActualLength);
end;
Benchmark
Just for fun I did a very primitive benchmark on random input strings with length < 100 and about 24% chance of a char being a digit:
program Benchmark;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, System.RegularExpressions, Windows;
function OP1(const s: string): string;
begin
Result := '';
for var i := 1 to Length(s) do
begin
if s[i] in ['0'..'9'] then
Result := Result + s[i];
end;
end;
function OP2(const s: string): string;
begin
Result := s;
for var i := Length(Result) downto 1 do
begin
if not(Result[i] in ['0'..'9']) then
Delete(Result, i, 1);
end;
end;
function OP3(const s: string): string;
begin
var RegEx := TRegEx.Create('[^0-9]');
Result := RegEx.Replace(s, '');
end;
function AR1(const S: string): string;
begin
SetLength(Result, S.Length);
var LActualLength := 0;
for var i := 1 to S.Length do
if CharInSet(S[i], ['0'..'9']) then
begin
Inc(LActualLength);
Result[LActualLength] := S[i];
end;
SetLength(Result, LActualLength);
end;
function AR2(const S: string): string;
begin
SetLength(Result, S.Length);
var ResChr := PChar(Result);
var LActualLength := 0;
for var i := 1 to S.Length do
if CharInSet(S[i], ['0'..'9']) then
begin
Inc(LActualLength);
ResChr^ := S[i];
Inc(ResChr);
end;
SetLength(Result, LActualLength);
end;
function AR3(const S: string): string;
begin
SetLength(Result, S.Length);
var ResChr := PChar(Result);
for var i := 1 to S.Length do
if CharInSet(S[i], ['0'..'9']) then
begin
ResChr^ := S[i];
Inc(ResChr);
end;
SetLength(Result, ResChr - PChar(Result));
end;
function RandomInputString: string;
begin
SetLength(Result, Random(100));
for var i := 1 to Result.Length do
Result[i] := Chr(Ord('0') + Random(42));
end;
begin
Randomize;
const N = 1000000;
var Data := TArray<string>(nil);
SetLength(Data, N);
for var i := 0 to N - 1 do
Data[i] := RandomInputString;
var f, c0, cOP1, cOP2, cOP3, cAR1, cAR2, cAR3: Int64;
QueryPerformanceFrequency(f);
QueryPerformanceCounter(c0);
for var i := 0 to High(Data) do
OP1(Data[i]);
QueryPerformanceCounter(cOP1);
Dec(cOP1, c0);
QueryPerformanceCounter(c0);
for var i := 0 to High(Data) do
OP2(Data[i]);
QueryPerformanceCounter(cOP2);
Dec(cOP2, c0);
QueryPerformanceCounter(c0);
for var i := 0 to High(Data) do
OP3(Data[i]);
QueryPerformanceCounter(cOP3);
Dec(cOP3, c0);
QueryPerformanceCounter(c0);
for var i := 0 to High(Data) do
AR1(Data[i]);
QueryPerformanceCounter(cAR1);
Dec(cAR1, c0);
QueryPerformanceCounter(c0);
for var i := 0 to High(Data) do
AR2(Data[i]);
QueryPerformanceCounter(cAR2);
Dec(cAR2, c0);
QueryPerformanceCounter(c0);
for var i := 0 to High(Data) do
AR3(Data[i]);
QueryPerformanceCounter(cAR3);
Dec(cAR3, c0);
Writeln('Computations per second:');
Writeln('OP1: ', Round(N / (cOP1 / f)));
Writeln('OP2: ', Round(N / (cOP2 / f)));
Writeln('OP3: ', Round(N / (cOP3 / f)));
Writeln('AR1: ', Round(N / (cAR1 / f)));
Writeln('AR2: ', Round(N / (cAR2 / f)));
Writeln('AR3: ', Round(N / (cAR3 / f)));
Readln;
end.
Result:
Computations per second:
OP1: 1398134
OP2: 875116
OP3: 39162
AR1: 3406172
AR2: 4063260
AR3: 4032343
As you can see, in this test at least, regular expressions are by far the slowest approach. And preallocating makes a major difference, while avoiding the _UniqueStringU issue appears to make only a relatively minor improvement.
But even with the very slow RegEx approach, you can do 40 000 calls per second. On my 13-year-old computer.
Hello I want to split a simple string into a group of two characters then reverse them.
For example MyStringToBeReversed to two charachters each My St ri ng To Be Re ve rs ed
then reverse each splited two charachters to :
St := ts
ri := ir
etc ...
Here's the code I'm using but it only displays one charachter on memo lines
procedure TForm7.Button1Click(Sender: TObject);
var
MyString: string;
i: integer;
k: integer;
j: integer;
begin
MyString:= Edit1.Text;
for i:= 1 to length(MyString) do
Memo1.Lines.Add(MyString[i]);
// Move(Str[1], MyString, Length(Str));
end;
end.
This should do what you need
function ReverseEachTwoChars(AInput : string) : string;
var
i : integer;
begin
if(Odd(Length(AInput))) then
begin
SetLength(AInput, Length(AInput) + 1);
AInput[Length(AInput)] := 'A';
end;
SetLength(Result, Length(AInput));
i := 1;
while(i < Length(Result)) do
begin
Result[i] := AInput[i + 1];
Result[i + 1] := AInput[i];
Inc(i, 2);
end;
end;
Test:
ShowMessage(ReverseEachTwoChars('010203040506'));
Output:
102030405060
I have a string, I set the coordinates for the selection of letters, but sometimes they mix up and I asked the coordinates with the numbers, how do I make that if for example '105DYUDXB28DYU13' had it done 'DYUDXBDYU'
tmpT.Put:=Trim(MidStr(S,8,6))+Trim(MidStr(S,37,3));
A solution with good performance is as follows (uses Character):
function RemoveNumbers(const AString: string): string;
var
i, j: integer;
begin
SetLength(result, AString.Length);
j := 0;
for i := 1 to AString.Length do
if not AString[i].IsDigit then
begin
inc(j);
result[j] := AString[i];
end;
SetLength(result, j);
end;
This function uses a few language and library features introduced after Delphi 7. To make this work in Delphi 7, you need to rewrite it slightly:
function RemoveNumbers(const AString: string): string;
var
i, j: integer;
begin
SetLength(result, Length(AString));
j := 0;
for i := 1 to Length(AString) do
if not (AString[i] in ['0'..'9']) then
begin
inc(j);
result[j] := AString[i];
end;
SetLength(result, j);
end;
The fine print: TCharHelper.IsDigit is Unicode-aware, and so it will return true for all Unicode digits. For instance, it will return true for
٣ (U+0663: ARABIC-INDIC DIGIT THREE),
੪ (U+0A6A: GURMUKHI DIGIT FOUR),
௫ (U+0BEB: TAMIL DIGIT FIVE),
៥ (U+17E5: KHMER DIGIT FIVE), and
᠗ (U+1817: MONGOLIAN DIGIT SEVEN).
If you only want to treat the characters '0'..'9' as digits, you can use the modernized version of the Delphi 7 test:
if not CharInSet(AString[i], ['0'..'9']) then
Also code with procedure and var parameter:
procedure RemoveNumbers(var Text: String);
var
Index: Integer;
begin
for Index := Length(Text) downto 1 do
if Text[Index] in ['0'..'9']
then Text := Copy(Text, 1, Index - 1) + Copy(Text, Index + 1, Length(Text) - Index);
end;
var
Text: String;
begin
Text := '105DYUDXB28DYU13';
RemoveNumbers(Text);
WriteLn(Text);
end.
I have a string comprising numerous words. How do I find and count the total amount of times that a particular word appears?
E.g "hello-apple-banana-hello-pear"
How would I go about finding all the "hello's" in the example above?
Thanks.
In Delphi XE you can use StrUtils.SplitString.
Something like this
var
Words: TstringDynArray;
Word: string;
WordCount: Integer;
begin
WordCount := 0;
Words := SplitString('hello-apple-banana-hello-pear', '-');
for Word in Words do
begin
if Word = 'hello' then
inc(WordCount);
end;
This would depend entirely on how you define a word and the text from which you wish to pull the words. If a "word" is everything between spaces, or "-" in your example, then it becomes a fairly simple task. If, however, you want to deal with hyphenated words, abbreviations, contractions, etc. then it becomes a lot more difficult.
More information please.
EDIT: After rereading your post, and if the example you give is the only one you want, then I'd suggest this:
function CountStr(const ASearchFor, ASearchIn : string) : Integer;
var
Start : Integer;
begin
Result := 0;
Start := Pos(ASearchFor, ASearchIn);
while Start > 0 do
begin
Inc(Result);
Start := PosEx(ASearchFor, ASearchIn, Start + 1);
end;
end;
This will catch ALL instances of a sequence of characters.
I'm sure there is plenty of code around to do this sort of thing, but it's easy enough to do it yourself with the help of Generics.Collections.TDictionary<K,V>.
program WordCount;
{$APPTYPE CONSOLE}
uses
SysUtils, Character, Generics.Collections;
function IsSeparator(const c: char): Boolean;
begin
Result := TCharacter.IsWhiteSpace(c);//replace this with whatever you want
end;
procedure PopulateWordDictionary(const s: string; dict: TDictionary<string, Integer>);
procedure AddItem(Item: string);
var
Count: Integer;
begin
if Item='' then
exit;
Item := LowerCase(Item);
if dict.TryGetValue(Item, Count) then
dict[Item] := Count+1
else
dict.Add(Item, 1);
end;
var
i, len, Start: Integer;
Item: string;
begin
len := Length(s);
Start := 1;
for i := 1 to len do begin
if IsSeparator(s[i]) then begin
AddItem(Copy(s, Start, i-Start));
Start := i+1;
end;
end;
AddItem(Copy(s, Start, len-Start+1));
end;
procedure Main;
var
dict: TDictionary<string, Integer>;
pair: TPair<string, Integer>;
begin
dict := TDictionary<string, Integer>.Create;
try
PopulateWordDictionary('hello apple banana Hello pear', dict);
for pair in dict do
Writeln(pair.Key, ': ', pair.Value);
finally
dict.Free;
end;
end;
begin
try
Main;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Output:
hello: 2
banana: 1
apple: 1
pear: 1
Note: I'm working with Delphi 2010 and don't have SplitString() available.
A very clever implementation I saw somewhere on the web:
{ Returns a count of the number of occurences of SubText in Text }
function CountOccurences( const SubText: string;
const Text: string): Integer;
begin
if (SubText = '') OR (Text = '') OR (Pos(SubText, Text) = 0) then
Result := 0
else
Result := (Length(Text) - Length(StringReplace(Text, SubText, '', [rfReplaceAll]))) div Length(subtext);
end; { CountOccurences }
I'm trying to extract a string from a text file using 2 delimiters. One to start and one to stop.
Example:
Hi my name is$John and I'm happy/today
What I need to do is to call a function that would return the string between $ and /. I've been looking everywhere but I can't seem to find something useful and I'm new to programming.
The above functions won't work if the 2nd text is also appearing before the 1st pattern...
You should use PosEx() instead of Pos():
You can do it with Pos and Copy:
function ExtractText(const Str: string; const Delim1, Delim2: string): string;
var
pos1, pos2: integer;
begin
result := '';
pos1 := Pos(Delim1, Str);
if pos1 > 0 then begin
pos2 := PosEx(Delim2, Str, pos1+1);
if pos2 > 0 then
result := Copy(Str, pos1 + 1, pos2 - pos1 - 1);
end;
end;
You can do it with Pos and Copy:
function ExtractText(const Str: string; const Delim1, Delim2: char): string;
var
pos1, pos2: integer;
begin
result := '';
pos1 := Pos(Delim1, Str);
pos2 := Pos(Delim2, Str);
if (pos1 > 0) and (pos2 > pos1) then
result := Copy(Str, pos1 + 1, pos2 - pos1 - 1);
end;
I'd do it something like this:
function ExtractDelimitedString(const s: string): string;
var
p1, p2: Integer;
begin
p1 := Pos('$', s);
p2 := Pos('/', s);
if (p1<>0) and (p2<>0) and (p2>p1) then begin
Result := Copy(s, p1+1, p2-p1-1);
end else begin
Result := '';//delimiters not found, or in the wrong order; raise error perhaps
end;
end;
Get em all
function ExtractText(const Str: string; const Delim1, Delim2: string): TStringList;
var
c,pos1, pos2: integer;
begin
result:=TStringList.Create;
c:=1;
pos1:=1;
while pos1>0 do
begin
pos1 := PosEx(Delim1, Str,c);
if pos1 > 0 then begin
pos2 := PosEx(Delim2, Str, pos1+1);
if pos2 > 0 then
result.Add(Copy(Str, pos1 + length(delim1), pos2 - (length(delim1) + pos1)));
c:=pos1+1;
end;
end;
end;
Gab, you can write a function to do this using a TFileStream class, and the Copy and Pos functions.
see this sample :
uses
Classes,
SysUtils;
function ExtractString(Const FileName: TFileName;Const IDel,FDel : AnsiString) : AnsiString;
Var
FileStream : TFileStream;
i,f : Integer;
begin
FileStream:= TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); //oopen the file
try
try
SetLength(Result, FileStream.Size); //set the size of the string
FileStream.Read(Pointer(Result)^, FileStream.Size);//read the content into a string
i:=Pos(IDel,Result);//search the initial delimiter
f:=Pos(FDel,Result);//search the final delimiter
Result:=Copy(Result,i+1,f-i-1); //extract the value between the delimiters
except
Result := '';
raise;
end;
finally
FileStream.Free;
end;
end;
and use in this way
ExtractString('your_file_name','$','/');
In the newer Delphi's you can do it like this.. (yay)
program Project40; {$APPTYPE CONSOLE}
uses RegularExpressions;
const
str = 'Is$John and I''m happy/today';
function GetStr(const aStr: string): string;
begin
Result := TRegEx.Match(aStr, '\$.*/').Value;
Result := Copy(Result, 2, Length(Result) - 2);
end;
begin
Writeln(GetStr(str));
ReadLn;
end.
Assuming both delimiters are single characters as per your post:
function ExtractDelimitedValueFromFile(const aFilename: String;
const aOpenDelim: Char;
const aCloseDelim: Char;
var aValue: String): Boolean;
var
i: Integer;
strm: TStringStream;
delimStart: Integer;
delimEnd: Integer;
begin
result := FALSE;
aValue := '';
delimStart := -1;
delimEnd := -1;
strm := TStringStream.Create;
try
strm.LoadFromFile(aFileName);
for i := 1 to strm.Size do
begin
if (delimStart = -1) and (strm.DataString[i] = aOpenDelim) then
delimStart := i
else if (delimStart <> -1) and (strm.DataString[i] = aCloseDelim) then
delimEnd := i;
result := (delimStart <> -1) and (delimEnd <> -1);
if result then
begin
aValue := Copy(strm.DataString, delimStart + 1, delimEnd - delimStart - 1);
BREAK;
end;
end;
finally
strm.Free;
end;
end;
Usage:
var
str: String;
begin
if ExtractDelimitedValueFromFile('path\filename.ext', '$', '/', str) then
// work with str
else
// delimited value not found in file
end;