We are using below code to sort the lines in a file. I gave input linesas below:
6 5 1 12 10
But am getting out as below:
10 12 1 5 6
I need out as
1 5 6 10 12
Is there any way to sort the numeric lines in Inno Setup.
procedure SortList(const FileName: string);
var
I: Integer;
Files: TStringList;
begin
Files := TStringList.Create;
try
Files.LoadFromFile(FileName);
for I := Files.Count - 1 downto 0 do
begin
Files.sort;
end;
Files.SaveToFile(FileName);
finally
Files.Free;
end;
end;
Thanks in Advance.
The following Quicksort proc should do the job:
//Start is the index of the first item on the list - usually 0
//Stop is the index of the last item of the list e.g. Count - 1
procedure QuickSort(var List: TStringList; Start, Stop: Integer);
var
Left: Integer;
Right: Integer;
Mid: Integer;
Pivot: integer;
Temp: integer;
begin
Left := Start;
Right := Stop;
Mid := (Start + Stop) div 2;
Pivot := StrToInt(List[mid]);
repeat
while StrToInt(List[Left]) < Pivot do Inc(Left);
while Pivot < StrToInt(List[Right]) do Dec(Right);
if Left <= Right then
begin
Temp := StrToInt(List[Left]);
List[Left] := List[Right]; // Swops the two Strings
List[Right] := IntToStr(Temp);
Inc(Left);
Dec(Right);
end;
until Left > Right;
if Start < Right then QuickSort(List, Start, Right); // Uses
if Left < Stop then QuickSort(List, Left, Stop); // Recursion
end;
instead of calling:
Files.sort;
use the following:
QuickSort(Files, 0, Files.Count - 1);
One caveat is that the file contents always have to be valid integers because I have not added error handeling for other cases.
The Quicksort function I used is a modified version of the one found at Torry's Delpi: http://www.swissdelphicenter.ch/torry/showcode.php?id=1916
Related
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;
Let's say we have this Integer 1234567890, we want it converted to a string with a separator = 1.234.567.890, we could do Format('%n',[1234567890.0]); but it's very slow. I wrote a function to speed it up considerably (more than 2x faster). How could I improve it further, or can you come up with a faster routine?
function MyConvertDecToStrWithDot(Const n: UInt64): string;
Var a,b,x: Integer;
z,step: Integer;
l: SmallInt;
begin
Result := IntToStr(n);
if n < 1000 then Exit;
l := Length(Result);
a := l div 3;
b := l mod 3;
step := b+1;
z := 4;
if b <> 0 then begin
Insert('.',Result,step);
Inc(z,step);
end;
for x := 1 to (a-1) do begin
Insert('.',Result,z);
Inc(z,4);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
Var a: Integer;
s: string;
begin
PerfTimerInit;
for a := 1 to 1000000 do
s := MyConvertDecToStrWithDot(1234567890);
Memo1.lines.Add(PerfTimerStopMS.ToString);
caption := s;
end;
32-bit
Format: ~230ms
My function: ~79ms
64-bit
Format: ~440ms
My function: ~103ms
In my tests, the following is ever so slightly faster:
function ThousandsSepStringOf(Num: UInt64): string;
const
MaxChar = 30; // Probably, 26 is enough: 19 digits + 7 separators
var
Count: Integer;
Rem: UInt64;
Res: array[0..MaxChar] of Char;
WritePtr: PChar;
begin
WritePtr := #Res[MaxChar];
WritePtr^ := #0;
Count := 0;
while Num > 0 do
begin
DivMod(Num, 10, Num, Rem);
Dec(WritePtr);
WritePtr^ := Char(Byte(Rem) + Ord('0'));
Inc(Count);
if Count = 3 then
begin
Dec(WritePtr);
WritePtr^ := '.';
Count := 0;
end;
end;
if WritePtr^ = '.' then
Inc(WritePtr);
Count := MaxChar - ((NativeInt(WritePtr) - NativeInt(#Res)) shr 1);
SetLength(Result, Count);
Move(WritePtr^, PByte(Result)^, Count * SizeOf(Char));
end;
Tested with:
procedure TestHisCode;
Var
a: Integer;
s: string;
SW: TStopwatch;
begin
Writeln('His code');
SW := TStopwatch.StartNew;
for a := 1 to KLoops do
s := MyConvertDecToStrWithDot(1234567890);
Writeln(SW.ElapsedMilliseconds);
Writeln(s);
Writeln;
end;
procedure TestMyCode;
Var
a: Integer;
s: string;
SW: TStopwatch;
begin
Writeln('My code');
SW := TStopwatch.StartNew;
for a := 1 to KLoops do
s := ThousandsSepStringOf(1234567890);
Writeln(SW.ElapsedMilliseconds);
Writeln(s);
Writeln;
end;
and:
TestHisCode;
TestMyCode;
TestMyCode;
TestHisCode;
TestMyCode;
TestHisCode;
TestHisCode;
TestMyCode;
Haven't properly tested the performance of this, however it should be cross-platform and locale independent:
function Thousands(const ASource: string): string;
var
I, LLast: Integer;
begin
Result := ASource;
LLast := Length(Result);
I := LLast;
while I > 0 do
begin
if (LLast - I + 1) mod 3 = 0 then
begin
Insert(FormatSettings.ThousandSeparator, Result, I);
Dec(I, 2);
end
else
Dec(I);
end;
end;
Note: It obviously just works on integers
It's better to insert the separators directly while constructing the string instead of inserting separators later into the converted string because each insertion involves a lot of data movements and performance degradation. Besides avoid the division by 3 may improve performance a bit
This is what I get from my rusty Pascal after decades not using it
uses strutils;
function FormatNumber(n: integer): string;
var digit: integer;
count: integer;
isNegative: boolean;
begin
isNegative := (n < 0);
if isNegative then n := -n;
Result := '';
count := 3;
while n <> 0 do begin
digit := n mod 10;
n := n div 10;
if count = 0 then begin
Result := Result + '.';
count := 3;
end;
Result := Result + chr(ord('0') + digit);
dec(count);
end;
if isNegative then Result := Result + '-';
Result := reversestring(Result);
end;
See it in action: http://ideone.com/6O3e8w
It's also faster to just assign the characters directly instead of using concatenation operator/function like Victoria suggested. This is the improved version with only unsigned types
type string28 = string[28];
function FormatNumber(n: UInt64): string28;
var digit: integer;
length: integer;
count: integer;
c: char;
begin
count := 3;
length := 0;
while n <> 0 do begin
digit := n mod 10;
n := n div 10;
if count = 0 then begin
inc(length);
Result[length] := '.';
count := 3;
end;
inc(length);
Result[length] := chr(ord('0') + digit);
dec(count);
end;
for count := 1 to (length + 1) div 2 do begin
c := Result[count];
Result[count] := Result[length - count + 1];
Result[length - count + 1] := c;
end;
setlength(Result, length);
FormatNumber := Result;
end;
If the operation is done millions of times and is really a bottleneck after profiling, it's better to do in multiple threads along with SIMD
procedure TForm1.bFAT1Click(sender: TObject);
var
FAT: Integer;
begin
for FAT := 0 to memo1.lines.Count - 1 do
begin
if AnsiContainsStr(memo1.lines[FAT], 'Olive Oil') then
begin
ShowMessage('Olive Oil exist!');
end;
end;
// But how to show message if integer is empty?
end;
I want to do something if no line contains 'Olive Oil'. How to do it?
What you need is an Exit statement to leave the procedure as soon as you found a matching element. That way, when you reach the end of the procedure, you know that you have not found a matching element:
for FAT := 0 to memo1.lines.Count - 1 do
begin
if AnsiContainsStr(memo1.lines[FAT], 'Olive Oil') then
begin
ShowMessage('Olive Oil exist!')
Exit; // we can stop here since we found it
end;
end;
// we only come here if no line contained 'Olive Oil' (because of the EXIT)
ShowMessage('Olive Oil does not exist!');
Edit: (inspired by #David) It is good practice to separate your logic from the UI / display (for example ShowMessage). To do that you can define a function like this:
function IndexOfLineContaining(const Text : String; Lines : TStrings) : Integer;
begin
for Result := 0 to Lines.Count - 1 do
if AnsiContainsStr(Lines[Result], Text) then
Exit;
Result := -1;
end;
On top of that you could easily define a boolean function:
function HasLineContaining(const Text : String; Lines : TStrings) : Boolean;
begin
Result := (IndexOfLineContaining(Text, Lines) > -1);
end;
and use that to do your message display:
if HasLineContaining('Olive Oil', Memo1.Lines) then
ShowMessage ('foo')
else
ShowMessage ('bar');
I suggest that you work a bit on your terminology to make your questions clearer. An integer cannot be empty and the sentence " do something if [FAT] do not found 'Olive Oil'." with FAT being an integer does not make any sense.
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;