Delphi: Remove chars from string - string

I have a string containing letters, numbers and other chars.
I want to remove from that string all numbers, dots and commas
Before: 'Axis moving to new position - X-Pos: 5.4mm / Y-Pos: 3.5mm'
After: 'Axis moving to new position - X-Pos mm / Y-Pos mm'
Unfortunately string.replace() only replaces one character. So I need several lines.
How can I avoid writing every replacement line by line?
sString := sString.Replace('0', '');
sString := sString.Replace('1', '');
sString := sString.Replace('2', '');
sString := sString.Replace('3', '');
sString := sString.Replace('3', '');
...
sString := sString.Replace(':', '');
sString := sString.Replace('.', '');

Although the OP's own solution is fine, it is somewhat inefficient.
Just for completeness, here's a slightly more optimized version:
function RemoveCharsFromString(const AString, AChars: string): string;
begin
SetLength(Result, AString.Length);
var ActualLength := 0;
for var i := 1 to AString.Length do
begin
if SomePredicate(AString[i]) then
begin
Inc(ActualLength);
Result[ActualLength] := AString[i];
end;
end;
SetLength(Result, ActualLength);
end;
The algorithm is independent of the particular predicate. In this case, the predicate is Pos(AString[i], AChars) = 0.

There are multiple ways of how you can approach this. Here are three solution.
Solution 1
You can go and simply loop though the source string checking each character to se if it is one of the characters that needs to be removed.
//Simple function that loops through all characters of the source strings removing them one by one
//It is manipulating the same string all the time
function Removechars1(sourceString: string; sCharsToBeRemoved: string):string;
var I: Integer;
begin
//Assign value of the source string to the result so we can work with result strin from now on
result := SourceString;
//Loop throught the whole result sring starting at end searching for characters to be removed
//We start at the end because when we will be removing characters from the string its length
//will be decreasing.
for I := Length(result) downto 1 do
begin
//Use Pos function to see if specific character in the result string can also be found
//in the sCharsToBeRemoved and therefore needs to be removed
if Pos(result[i], sCharsToBeRemoved) <> 0 then
begin
//If so we delete the specific character
Delete(result,I,1);
end;
end;
end;
Solution 2
Second solution is similar to the first one but it relies on adding characters non removable characters to the result. It is slightly slower than the first solution
//Slightly faster function that also loops through the whole sourceString character by character
//and adds such characters to result string if they are not present in sCharsToBeRemoved string
function RemoveChars2(sourceString: string; sCharsToBeRemoved: string):string;
var I: Integer;
begin
//Prepare enpty string for our result strung to which we will be copying our end characters
result := '';
//Loop through the whole string
for I := 1 to Length(sourceString) do
begin
//If specific haracter can't be found in sCharsToBeRemoved copy that character to the
//result string
if Pos(sourceString[I], sCharsToBeRemoved) = 0 then
begin
result := result + sourceString[I];
end;
end;
end;
Solution 3
The third solution relies on string helpers for replacing specific characters. This one is by far the fastest of the three needing about half the time that is needed by the first solution to process the same job
//Another approach of removing characters from source string that relies on Replace string helper
function RemoveChars3(sourceString: string; sCharsToBeRemoved: string):string;
var I: Integer;
begin
//Assign value of the source string to the result so we can work with result strin from now on
result := sourceString;
//Loop through the sCharsToBeRemoved string so we can then call Replace string helper in order
//to replace all occurrences of such character in sourceString;
for I := 1 to Length(sCharsToBeRemoved) do
begin
result := result.Replace(sCharsToBeRemoved[I],'');
end;
end;
Main advantages of this approach is that it is quite fast and could easily modified to be able to remove whole substrings and not only individual characters.
PS: In my testing your solution was actually the slowest needing about 20% more time than my first solution
TestTring
jfkldajflkajdflkajlkčfjaskljflakjflkdasjflkčjdfkldafjadklfjadklfjaldkakljfkldajflkčadjslfkjadklfjlkadčjflkajdflčkjadlkfjladkdjfkladjflkadjflkčjadklčfjaldkjfkladjfklajflkadjfkadgfkljdklfjawdkojfkladsjflčaksdjdfklčasjdklčfdfklčjadslkdfjlka
CharsToBeRemoved
asjk
Solution 1
1230 ms
Solution 2
1263 ms
Solution 3
534 ms
Your solution
1574 ms

This solution works with a very small footprint of code lines.
I just split the string on each occurence of a char which should be removed. After that I put the pieces together without the removed chars.
uses System.SysUtils;
function RemoveCharsFromString(sFullString: string; sCharsToBeRemoved: string): string;
var
splitted: TArray<String>;
begin
splitted := sFullString.Split(sCharsToBeRemoved.ToCharArray());
Result := string.Join('', splitted);
end;

string.Replace has an overload where you can pass flags to replace all instead of just one. Example:
sString := sString.Replace('1', '', [rfReplaceAll, rfIgnoreCase]);
Edit: Stringlist equivalent:
sString.Text := sString.Text.Replace('1', '', [rfReplaceAll, rfIgnoreCase]);

Working with strings spends more time, use PChar instead.
I think here's a slightly more optimized version
function RemoveCharsFromString(const AString, AChars: String): String;
var
i, j, k, LenString, LenChars : Integer;
PString, PChars : PChar;
label
Ends;
begin
PString := Pointer(AString);
PChars := Pointer(AChars);
LenString := AString.Length;
LenChars := AChars.Length;
k := 0;
for i := 0 to LenString - 1 do
begin
for j := 0 to LenChars - 1 do
if PString[i] = PChars[j] then
Goto Ends;
PString[k] := PString[i];
Inc(k);
Ends :
end;
PString[k] := #0;
Result := StrPas(PString);
end;
If you don't like Labels, use this code :
function RemoveCharsFromString(const AString, AChars: String): String;
var
i, j, k, LenString, LenChars : Integer;
PString, PChars : PChar;
found : Boolean;
begin
PString := Pointer(AString);
PChars := Pointer(AChars);
LenString := AString.Length;
LenChars := AChars.Length;
k := 0;
for i := 0 to LenString - 1 do
begin
found := False;
for j := 0 to LenChars - 1 do
if PString[i] = PChars[j] then
begin
found := True;
Break;
end;
if not found then
begin
PString[k] := PString[i];
Inc(k);
end;
end;
PString[k] := #0;
Result := StrPas(PString);
end;
You can call it like this :
sString := RemoveCharsFromString(sString, '0123456789.,');

Related

Extract multiple substring

I have a string 123HEREWEGOMAMAMIAGOWILLYOULETMEGOMAMAMIATOLOVEYOUSOMAMAMIASOIHATEYOUMAMAMIAHEY How can i get all available MAMAMIA+ 2 string length ? I need : MAMAMIAGO, MAMAMIASO, etc.
My problem, on last substring found give me wrong output. It render the begining of string with length of substring given : 123HEREWE instead of MAMAMIAGO.
I am using this function:
function Occurrences(const Substring, Text: string): Integer;
var
offset: Integer;
begin
Result := 0;
offset := PosEx(Substring, Text, 1);
while offset <> 0 do
begin
inc(Result);
offset := PosEx(Substring, Text, offset + Length(Substring));
memo1.Lines.Add(Copy(Text, offset, Length(Substring)+2));
end;
end;
my procedure
procedure TFH129.btn1Click(Sender: TObject);
var
s: string;
i: Integer;
begin
s := '123HEREWEGOHEREWEGOMAMAMIAGOWILLYOULETMEGOMAMAMIATOLOVEYOUSOMAMAMIASOIHATEYOUMAMAMIAHEY00';
i := Occurrences('MAMAMIA', s);
end;
You are adding the matching text in the wrong place, without checking if the added match exceeds the string length.
When entering the while loop, first thing to do is to check if the added match does not exceed the search string length. Then you can add the match before starting a new search.
procedure ExtractSubStringsPlus2(const SubString, SearchString: string; list: TStringList);
// Extract found sub strings together with the next two characters into a list
// Use StrUtils.PosEx if Delphi version is older than XE3
var
offset,len: integer;
begin
list.Clear;
len := Length(SubString);
offset := Pos(Substring, SearchString, 1);
while offset <> 0 do
begin
// Test if added length is past length of search string
if (offset + len + 1 > Length(SearchString))
then break;
// Copy found match
list.Add(Copy(SearchString,offset,len+2));
// Continue search
offset := Pos(Substring, SearchString, offset + len);
end;
end;
Your problem is as described below in the added comment:
function Occurrences(const Substring, Text: string): Integer;
var
offset: Integer;
begin
Result := 0;
offset := PosEx(Substring, Text, 1);
while offset <> 0 do
begin
inc(Result);
offset := PosEx(Substring, Text, offset + Length(Substring));
// If the string isn't found any more, offset becomes 0, but
// you still add a new string to the memo...
memo1.Lines.Add(Copy(Text, offset, Length(Substring)+2));
end;
end;
Use this instead:
FUNCTION Occurrences(CONST SubString,Text : STRING): Cardinal;
CONST
HellFreezesOver = FALSE;
VAR
OFS : Cardinal;
BEGIN
Result:=0; OFS:=0;
REPEAT
OFS:=PosEx(SubString,Text,OFS+1);
// Here I terminate the loop, in case the string isn't found any more.
IF OFS=0 THEN BREAK;
INC(Result);
Memo1.Lines.Add(COPY(Text,OFS,LENGTH(SubString)+2))
UNTIL HellFreezesOver
END;
One very simple way using TstringList :
Var aList: TstringList;
i: integer;
begin
aList := TstringList.create;
try
aList.lineBreak := 'MAMAMIA';
aList.text := 'x' + '123HEREWEGOMAMAMIAGOWILLYOULETMEGOMAMAMIATOLOVEYOUSOMAMAMIASOIHATEYOUMAMAMIAHEY';
For I := 1 to aList.count-1 do
if length(aList[i]) >=2 then memo1.Lines.Add(aList.lineBreak + Copy(aList[i], 1, 2));
finally
aList.free;
end;
end;

How to remove space around a character?

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.

Find the last occurrence of char in a string

Does there exist any RTL Delphi function to determine the position of the last occurrence of a char in a string?
try the LastDelimiter function which is part of the SysUtils unit.
RRUZ answered the actual question (he gave you a RTL function).
Still, I cannot quite resist giving a simple code snippet that does what you want:
function LastCharPos(const S: string; const Chr: char): integer;
var
i: Integer;
begin
result := 0;
for i := length(S) downto 1 do
if S[i] = Chr then
Exit(i);
end;
Since this does exactly what you want and offer no other features, it is far more compact (especially when we use the Exit(Result) syntax of Delphi 2009 and later) and probably slightly faster. In Delphi 2007, however, you have to do
function LastCharPos(const S: string; const Chr: char): integer;
var
i: Integer;
begin
result := 0;
for i := length(S) downto 1 do
if S[i] = Chr then
begin
result := i;
break; // or Exit; if you prefer that
end;
end;
Use StrRScan or AnsiStrRScan, both in the SysUtils unit. The latter, despite its name, works on Unicode characters in the Delphi versions where string is UnicodeString. (If you still need the "real" Ansi version, use the AnsiStrings unit.)
These functions search for exactly one character, whereas LastDelimiter searches for any of several characters from the given list of possibilities — think of StrRScan as LastDelimiter optimized for a one-character Delimiters argument.
The best cross-platform solution is TStringHelper.LastIndexOf, it exists since Delphi XE4.
Note, that this function is 0-based.
And here's my contribution for finding the position of the nth occurrence of a substring within a string.
function GetPositionOfNthOccurence(sSubStr, sStr: string; iNth: integer): integer;
var
sTempStr: string;
iIteration: integer;
iTempPos: integer;
iTempResult: integer;
begin
result := 0;
// validate input parameters
if ((iNth < 1) or (sSubStr = '') or (sStr = '')) then exit;
// evaluate
iIteration := 0;
iTempResult := 0;
sTempStr := sStr;
while (iIteration < iNth) do
begin
iTempPos := Pos(sSubStr, sTempStr);
if (iTempPos = 0) then exit;
iTempResult := iTempResult + iTempPos;
sTempStr := Copy(sStr, iTempResult + 1, Length(sStr) - iTempResult);
inc(iIteration);
end;
result := iTempResult;
end;

How to delete chars from string until first char is a letter?

I have a program which works with strings (Pascal). After reading a string if the first char is not a letter then I need to delete all first characters until the first is a letter. I have tried to write it several times, but always it deletes all string or nothing.
If program reads "123%^&abc" then result should be "abc"
In ASCII table letters are from 65..90 and from 97..122
This is how far I am:
variables a: set of 65..90;
b: set of 97..122;
-------------------
bool:=false;
While (bool=false) do
begin
Writeln(s[1]);
If (Ord(s[1]) in a) or (Ord(s[1]) in b) then
begin
bool:=true;
end else
delete(s,1,1);
end;
I don't understand why it does not work?
Can you help me with this little procedure? Thank you.
You could do
function RemoveNonAlphaASCIIFromStart(const Str: AnsiString): AnsiString;
const
ALPHA = ['A'..'Z', 'a'..'z'];
var
i: Integer;
firstIndex: integer;
begin
result := '';
firstIndex := 0;
for i := 1 to length(Str) do
if Str[i] in ALPHA then
begin
firstIndex := i;
break;
end;
if firstIndex > 0 then
result := Copy(Str, firstIndex, length(Str));
end;
or, as a procedure
procedure RemoveNonAlphaASCIIFromStart(var Str: AnsiString);
const
ALPHA = ['A'..'Z', 'a'..'z'];
var
i: Integer;
firstIndex: integer;
begin
firstIndex := 0;
for i := 1 to length(Str) do
if Str[i] in ALPHA then
begin
firstIndex := i;
break;
end;
if firstIndex > 0 then
Delete(Str, 1, firstIndex - 1)
else
Str := '';
end;
For more sophisticated methods, that also work with Unicode Delphi, see my answer to a similar question. [This removes all non-alpha chars from the string.]
So, why doesn't your algorithm work? Well, it should work, and it works for me. But notice that it can be written in the slightly more elegant form
const
ALPHA = ['A'..'Z', 'a'..'z'];
while true do
if (length(s) = 0) or (s[1] in ALPHA) then
break
else
delete(s, 1, 1);
One problem, however, with the OP's original code is that it will fail if s is the empty string. Indeed, then s[1] doesn't exist. It won't work either if s consists entirely of non-alpha characters (e.g. '!"#¤%).
Allthough the previous solutions do work, they are highly ineffitient. Because of 2 reasons:
1. Searching in a set is time consuming
2. Deleting every time a character out of a string is even more ineffitient, as the string (object) has to remove the character internally and adjust its array, etc.
Ideally you cast your string into PChar and work with that, while checking the char-range "manually". We'll let the search run until we find the first letter and only then we call the DeleteString method. Here's a demo on my approach:
procedure Frapp;
var
TheString: string;
pcStr: PChar;
StrLen, I: Integer;
begin
TheString := '123%^&abc';
StrLen := Length(TheString);
pcStr := PChar(TheString);
for I := 0 to StrLen - 1 do
begin
if ((pcStr^ >= #65) and (pcStr <= #90)) or ((pcStr >= #97) and (pcStr <= #122)) then
begin
Delete(TheString, 1, I);
Break;
end;
Inc(pcStr);
end;
end;

How many different letters are in string

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;

Resources