Related
I need to remove repeated spaces from a string.
The following code, grabbed from internet, works decently except that it duplicate the first char of the string.
Also maybe there is something faster that this.
function DeleteRepeatedSpaces(OldText: string): string;
var
i: integer;
s: string;
begin
if length(OldText) > 0 then
s := OldText[1]
else
s := '';
for i := 1 to length(OldText) do
begin
if OldText[i] = ' ' then
begin
if not (OldText[i - 1] = ' ') then
s := s + ' ';
end
else
begin
s := s + OldText[i];
end;
end;
DelDoubleSpaces := s;
end;
Function based on the simplest state machine (DFA). Minimum of memory reallocations.
State is number of continuous spaces.
J is count of deleted spaces.
function DeleteRepeatedSpaces(const s: string): string;
var
i, j, State: Integer;
begin
SetLength(Result, Length(s));
j := 0;
State := 0;
for i := 1 to Length(s) do begin
if s[i] = ' ' then
Inc(State)
else
State := 0;
if State < 2 then
Result[i - j] := s[i]
else
Inc(j);
end;
if j > 0 then
SetLength(Result, Length(s) - j);
end;
Iterate all members of the string, move the characters to the Result, but skip repeated spaces.
function DeleteRepeatedSpaces(const OldText: string): string;
var
i,j,hi: Integer;
begin
SetLength(Result,Length(OldText));
i := Low(OldText);
j := i;
hi := High(OldText);
while (i <= hi) do begin
Result[j] := OldText[i];
Inc(j);
if (OldText[i] = ' ') then begin
repeat //Skip additional spaces
Inc(i);
until (i > hi) or (OldText[i] <> ' ');
end
else
Inc(i);
end;
SetLength(Result,j-Low(Result)); // Set correct length
end;
The above code is rather fast (faster than any other contribution, so far).
Below is an even more optimized routine:
function DeleteRepeatedSpaces(const OldText: string): string;
var
pO,pR: PChar;
begin
SetLength(Result,Length(OldText));
pR := Pointer(Result);
pO := Pointer(OldText);
while (pO^ <> '') do begin
pR^ := pO^;
Inc(pR);
if (pO^ <> ' ') then begin
Inc(pO);
Continue;
end;
repeat // Skip additional spaces
Inc(pO);
until (pO^ = '') or (pO^ <> ' ');
end;
SetLength(Result,pR-Pointer(Result));
end;
The following isn't wildly efficient, but possibly more so that processiing the string character by character because it doesn't require a new string allocation for each character in the output:
function RemoveDupSpaces(const Input : String) : String;
var
P : Integer;
begin
Result := Input;
repeat
P := Pos(' ', Result); // that's two spaces
if P > 0 then
Delete(Result, P + 1, 1);
until P = 0;
end;
You can use something like this:
function DeleteRepeatedSpaces(const s: string):string;
var
i:integer;
begin
Result := '';
for i := 1 to Length(S) do begin
if not ((s[i]=' ') and (s[i-1]=' ')) then begin
Result := Result + s[i];
end;
end;
end;
Delete two o more spaces contiguous in a string.
This string (without spaces):
The string have groups of spaces inside
return this:
The string have groups of spaces inside
This string (with spaces groups inside):
The string have groups of spaces inside
Return this:
The string have groups of spaces inside
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;
Say I have the following string:
s := 'This , is, the Delphi , World!';
I would like the following output:
Result := 'This,is,the Delphi,World!';
Basically I need a routine that strips ALL occurrences of spaces ONLY if they appears before or after the comma char (which is my delimiter), leaving intact spaces between other words.
Any help is much appreciated.
What do you think of this solution?
function RemoveSpacesAroundDelimiter(var aString: string; aDelimiter:
string): string;
begin
while AnsiContainsText(aString, aDelimiter + ' ') do
begin
aString := StringReplace(aString, ', ', aDelimiter, [rfReplaceAll, rfIgnoreCase]);
end;
while AnsiContainsText(aString, ' ' + aDelimiter) do
begin
aString := StringReplace(aString, ' ' + aDelimiter, aDelimiter, [rfReplaceAll, rfIgnoreCase]);
end;
Result := aString;
end;
thanks
fabio
Sounds like a task for TStringList.
function UltraTrim(Value: string): string;
var
sl: TStringList;
i: Integer;
begin
sl := TStringList.Create;
try
// Prevent the stringlist from using spaces as delimiters too.
sl.StrictDelimiter := True;
// Set the comma separated text.
sl.CommaText := Value;
// Trim each item.
for i := 0 to sl.Count -1 do
sl[i] := Trim(sl[i]);
// Concat back to comma separated string.
Result := sl.CommaText;
finally
sl.Free;
end;
end;
A fast version could be:
function RemoveSpacesAroundDelimiter(const aString: string; aDelimiter: char = ','): string;
var S, D, D2: PChar;
begin
SetLength(result,length(aString));
if aString<>'' then
begin
S := pointer(aString);
D := pointer(result);
while S^<>#0 do
begin
if S^=' ' then
begin
D2 := D;
repeat
inc(S);
D^ := ' ';
inc(D);
until S^<>' ';
if S^=#0 then
break;
if S^=aDelimiter then
D := D2; // trim spaces before comma
end;
D^ := S^;
if (S[0]=aDelimiter) and (S[1]=' ') then
repeat inc(S) until S^<>' ' else // trim spaces after comma
inc(S);
inc(D);
end;
SetLength(result,D-pointer(result));
end;
end;
Some test code:
assert(RemoveSpacesAroundDelimiter('one two,three')='one two,three');
assert(RemoveSpacesAroundDelimiter('one two , three')='one two,three');
assert(RemoveSpacesAroundDelimiter('one,two,three')='one,two,three');
assert(RemoveSpacesAroundDelimiter('one , two, three')='one,two,three');
Copy characters one-by-one into the destination buffer, but look for spaces and delimiters, and remember the last location you copied a non-space character into. If you see a space and the last non-space you copied was the delimiter, then skip the space. If it's a space and the last character you copied wasn't the delimiter, then copy it to the destination, but remember the last non-space you added. That way, if you see a delimiter later, you can go back and overwrite it.
function RemoveSpacesAroundDelimiter(const AString: string; ADelimiter: Char): string;
var
c: Char;
dest: Integer;
LastNonSpace: Integer;
HaveDelimiter: Boolean;
begin
Assert(ADelimiter <> ' ');
SetLength(Result, Length(AString));
dest := 1;
LastNonSpace := 0;
HaveDelimiter := False;
for c in AString do begin
if (c = ' ') and HaveDelimiter then
continue; // Skip this character
if c = ADelimiter then begin
dest := LastNonSpace + 1;
HaveDelimiter := True;
end else
HaveDelimiter := False;
Result[dest] := c;
if c <> ' ' then
LastNonSpace := dest;
Inc(dest);
end;
SetLength(Result, dest - 1);
end;
If you are using Delphi XE or above you can do this trivially in a single line of code, using a regular expression.
program regex;
{$APPTYPE CONSOLE}
uses
RegularExpressions;
const
Input = 'This , is, the Delphi , World!';
begin
Writeln(TRegEx.Replace(Input, ' *, *', ','));
Readln;
end.
Naturally this is not the fastest running of the solutions on offer, but maybe that doesn't matter to you.
You can use regular expressions. You want to find the delimiter preceded or followed by any number of spaces, and replace it all with a single copy of the delimiter.
function RemoveSpacesAroundDelimiter(const AString: string; const ADelimiter: string): string;
var
re: TPerlRexEx;
begin
re := TPerlRegEx.Create;
try
re.RegEx := '\s*' + TPerlRegEx.EscapeRegExChars(ADelimiter) + '\s*';
re.Subject := AString;
re.Replacement := TPerlRegEx.EscapeRegExChars(ADelimiter);
re.ReplaceAll;
Result := re.Subject;
finally
re.Free;
end;
end;
Newer Delphi versions can use the built-in RegularExpressionCore unit. Older versions can use the equivalent PerlRegEx unit from Jan Goyvaerts.
Mick previously posted an answer demonstrating this, but he deleted it because he got the regular expression wrong (deleting all spaces instead of just the ones abutting the delimiter).
The simpler and easiest way is to use regular expressions. The last thing you would need is a huge complicated code block to solve such a simple problem. Unfortunatly I don't have Delphi with me right now, I can't test this code, but if it's nothing exactly like this, it's very very close:
s := 'This , is, the Delphi , World!';
RegEx := TRegEx.Create('[ ]*,[ ]*');
CleanStr := RegEx.Replace(s, ',');
I have this solution:
slValores.DelimitedText := StringReplace(sListSummary,' ','',[rfReplaceAll]);
I thought this was worth adding because it will work with early versions of Delphi, which the stringlist solution (which I liked) does not.
It is alo reasonably quick, I believe, and fairly simple to read and understand.
function TForm1.UltraTrim(const InString : String; Delim : Char) : String;
var
Buf : String;
i : Integer;
Token : String;
begin
Result := '';
if Trim(InString) <> '' then begin
i := 1;
Buf := StringReplace(InString, Delim, #0, [rfReplaceAll]) + #0;
while i < Length(Buf) do begin
Token := StrPas(#Buf[i]);
i := i + Length(Token) + 1;
Result := Result + Delim + Trim(Token);
end;
Result := Copy(Result,2,Length(Result));
end;
end;
Using Jedi Code Library, answer by #GolezTrol can be reformulated using one-liner.
function UltraTrim(Value: string): string;
begin
Result := JclStringList.Split(Value, ',').Trim.Join(',')
end;
http://en.wikipedia.org/wiki/Fluent_interface
http://wiki.delphi-jedi.org/wiki/JCL_Help:JclStringList
with this function :
function MBTrim(iStr :string):string;
const CTc= 3{Conditions Count};
CT :array[0..(CTc-1),0..1]of string= ( (' ,', ','), (', ', ','), (' ', ' ') );
var i :Integer;
begin
for i := 0 to CTc-1 do while Pos(CT[i,0], iStr) > 0 do
iStr:= StringReplace(iStr, CT[i,0], CT[i,1], [rfReplaceAll, rfIgnoreCase]);
Result:= Trim(iStr);
end;
you can add other conditions simply.
for example i add (' ', ' ') to convert space between words like :
'This , is, the Delphi , World!'
Changed, one more time.
while (pos(', ',s)>0) or (pos(' ,',s)>0) do begin
s := StringReplace(s, ', ', ',', [rfReplaceAll]);
s := StringReplace(s, ' ,', ',', [rfReplaceAll]); end;
OK for all the Delphi versions.
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 have to write program that counts how many different letters are in string.
For example "abc" will give 3; and "abcabc" will give 3 too, because there are only 3 different letters.
I need to use pascal, but if you can help with code in different languages it would be very nice too.
Here is my code that does not work:
var s:string;
i,j,x,count:integer;
c:char;
begin
clrscr;
Readln(s);
c:=s[1];
x:=1;
Repeat
For i:=1 to (length(s)) do
begin
If (c=s[i]) then
begin
delete(s,i,1);
writeln(s);
end;
end;
c:=s[1];
x:=x+1;
Until length(s)=1;
Writeln(x);
x is the different letter counter;
Maybe my algorythm is very bad.. any ideas? Thank you.
You've got answers on how to do it, here's why your way doesn't work.
First of all intuitively you had a good idea: Start with the first char in the string, count it (you forgot to include the counting code), remove all occurrences of the same char in the string. The idea is inefficient, but it would work. You ran into trouble with this bit of code:
For i:=1 to (length(s)) do
begin
If (c=s[i]) then
begin
delete(s,i,1);
end;
end;
The trouble is, Pascal will take the Length(s) value when it sets up the loop, but your code changes the length of the string by removing chars (using delete(s,i,1)). You'll end up looking at bad memory. The secondary issue is that i is going to advance, it doesn't matter if it matched and removed an char or not. Here's why that's bad.
Index: 12345
String: aabbb
You're going to test for i=1,2,3,4,5, looking for a. When i is 1 you'll find a match, remove the first char, and your string is going to look like this:
Index: 1234
String: abbb
You're now testing with i=2, and it's not a match, because s[2] =b. You just skiped one a, and that given a is going to stay in the array an other round and cause your algorithm to count it twice. The "fixed" algorithm would look like this:
i := 1;
while i <= Length(s) do
if (c=s[i]) then
Delete(s,i,1)
else
Inc(i);
This is different: In the given example, if I found a match at 1, the cursor doesn't advance, so it sees the second a. Also because I'm using a while loop, not a for loop, I can't get in trouble with possible implementation details of the for loop.
Your algorithm has an other problem. After the loop that removes all occurrences of the first char in string you're preparing the next loop using this code:
c:=s[1];
The trouble is, if you feed this algorithm an string of the form aa (length=2, two identical chars), it's going to enter the loop, delete or occurrences of a (those turning s into an EMPTY string) and then attempt to read the first char of the EMPTY string.
One final word: Your algorithm should handle the empty string on input, returning an count=0. Here's the fixed algorithm:
var s:string;
i,count:integer;
c:char;
begin
Readln(s);
count:=0;
while Length(s) > 0 do
begin
Inc(Count);
c := s[1];
i := 1;
while i <= Length(s) do
begin
If (c=s[i]) then
delete(s,i,1)
else
Inc(i);
end;
end;
Writeln(Count);
Readln;
end.
I am a Delphi expert, so I don't quite know how restrictive plain Pascal is. Nevertheless, this is Delphi:
// Returns the number of *distinct* "ANSI" characters in Str
function NumChrs(const Str: AnsiString): integer;
var
counts: array[0..255] of boolean;
i: Integer;
begin
ZeroMemory(#counts[0], sizeof(boolean) * length(counts));
for i := 1 to length(Str) do
counts[ord(Str[i])] := true;
result := 0;
for i := 0 to high(counts) do
if counts[i] then
inc(result);
end;
The first line can be written
for i := 0 to high(counts) do
counts[i] := false;
if you cannot use the Windows API (or the Delphi FillChar function).
If you wish to have Unicode support (as in Delphi 2009+), you can do
// Returns the number of *distinct* Unicode characters in Str
function NumChrs(const Str: string): integer;
const
AllocBy = 1024;
var
FoundCodepoints: array of integer;
i: Integer;
procedure Push(Codepoint: integer);
var
i: Integer;
begin
for i := 0 to result - 1 do
if FoundCodepoints[i] = Codepoint then
Exit;
if length(FoundCodepoints) = result then
SetLength(FoundCodepoints, length(FoundCodepoints) + AllocBy);
FoundCodepoints[result] := Codepoint;
inc(result);
end;
begin
result := 0;
for i := 1 to length(Str) do
Push(ord(Str[i]));
end;
Here's my version. I'm not saying you'll get a great mark in your assignment if you hand this in.
function NumberOfUniqueChars(s: string): Integer;
var
i, j: Integer;
c: char;
begin
for i := 1 to Length(s) do
for j := i+1 to Length(s) do
if s[i]<s[j] then
begin
c := s[i];
s[i] := s[j];
s[j] := c;
end;
Result := 0;
for i := 1 to Length(s) do begin
if (i=1) or (s[i]<>c) then
inc(Result);
c := s[i];
end;
end;
And using a Delphi construct (not efficient, but clean)
function returncount(basestring: String): Integer;
var charstrings: TStringList;
I:Integer;
begin
Result := 0;
charstrings := TStringlist.create;
try
charstrings.CaseSensitive := False;
charstrings.Duplicates := DupIgnore;
for I := 1 to length(basestring) do
charstrings.Add(basestring[i]);
Result := charstrings.Count;
finally
charstrings.free;
end;
end;
Different languages are ok?
RUBY:
s = "abcabc"
=> "abcabc"
m = s.split(//)
=> ["a", "b", "c", "a", "b", "c"]
p = m & m
=> ["a", "b", "c"]
p.count
=> 3
A Delphi version. Same idea as #The Communist Duck Python version.
function GetNumChars(Str: string): Integer;
var
s: string;
c: Char;
begin
s := '';
for c in Str do
begin
if Pos(c, s) = 0 then
begin
s := s + c;
end;
end;
Result := Length(s);
end;
Just tossing in a set-alternative...
program CountUniqueChars;
{$APPTYPE CONSOLE}
uses
SysUtils;
var
InputStr: String;
CountedChr: Set of Char;
TotalCount: Integer;
I: Integer;
begin
Write('Text: ');
ReadLn(InputStr);
CountedChr := [];
TotalCount := 0;
for I := 1 to Length(InputStr) do
begin
Write('Checking: ' + InputStr[i]);
if (InputStr[i] in CountedChr)
then WriteLn(' --')
else begin
Include(CountedChr, InputStr[i]);
Inc(TotalCount);
WriteLn(' +1')
end;
end;
WriteLn('Unique chars: ' + IntToStr(TotalCount));
ReadLn;
end.
In Python, with explanation if you want it for any other language: (Since you wanted different languages)
s = 'aahdhdfrhr' #s is the string
l = [] #l is an empty list of some kind.
for i in s: #Iterate through the string
if i not in l: #If the list does not contain the character
l.append(i) #Add the character to the list
print len(l) #Print the number of characters in the list
function CountChars(const S:AnsiString):Integer;
var C:AnsiChar; CS:Set of AnsiChar;
begin
Result := 0;
CS := [];
for C in S do
if not (C in CS) then
begin
CS := CS + [C];
Inc(Result);
end;
end;