I have a Question about Delphi StringLists and sorting them. I am sorting a list of attributes (with duplicate entries) so I need to retain their original index before the sort. Here is a sample of what I am trying
procedure TestFind;
var
i, iIndex :integer;
slStrings : TStringlist;
begin
slStrings := TStringList.Create;
slStrings.Sorted := False;
slStrings.Add('Zebra');
slStrings.AddObject('Zebra',TObject(1));
slStrings.Add('Bat');
slStrings.AddObject('Bat',TObject(2));
slStrings.Add('Cat');
slStrings.AddObject('Cat',TObject(3));
slStrings.Add('Hat');
slStrings.AddObject('Hat',TObject(4));
slStrings.Add('Aat');
slStrings.AddObject('Aat',TObject(5));
slStrings.sorted := True;
if slStrings.Find('Zebra',iIndex) then
begin
while slStrings.Strings[iIndex] = slStrings.Strings[iIndex + 1] do
begin
i := ObjectToInt(slStrings.Objects[iIndex]) ;
AddMemoData ('Stringlist Found at Position: ' + inttoStr(i) + ' Current index position is: ' + inttoStr(iIndex), false);
inc(iIndex);
end;
i := ObjectToInt(slStrings.Objects[iIndex]) ;
AddMemoData ('Stringlist Found at Position: ' + inttoStr(i) + ' Current index position is: ' + inttoStr(iIndex), false);
end;
end;
When I run this I get a Value of 0,8 for Zebra, this makes no sense to me, I would expect a message of 1,4
I really can't work out what your code is trying to achieve, but it is accessing beyond the end of the list. To avoid that your while test can be modified like so:
while (iIndex<slStrings.Count-1)
and (slStrings.Strings[iIndex] = slStrings.Strings[iIndex + 1]) do
Your use of Objects[] will work. Values placed there are kept with their matching Strings[] values when the list is sorted.
However, if I were you I would not use a string list for this task. I would declare a record like this:
TMyRec = record
Name: string;
Index: Integer;
end;
I would hold them in a TList<TMyRec> and then sort them using a custom comparer.
I note that you add each object twice, once with an associated index, and once without. Those latter instances will get a default index value of 0. I also observe that the code you present will not execute because of the out of bounds error that I identified. Further, even when you fix that it does not give output of the form that you claim.
In other words, it appears that the code you posted is very different from the code that you are running. I've answered based on the code that you included in the question. I hope that you can accept an answer on that basis and don't expect help with the code that you have, that we cannot see. Perhaps I should just have voted to close.
Anyway, perhaps the main problem is here:
slStrings.Add('Zebra');
slStrings.AddObject('Zebra',TObject(1));
slStrings.Add('Bat');
slStrings.AddObject('Bat',TObject(2));
slStrings.Add('Cat');
slStrings.AddObject('Cat',TObject(3));
slStrings.Add('Hat');
slStrings.AddObject('Hat',TObject(4));
slStrings.Add('Aat');
slStrings.AddObject('Aat',TObject(5));
This is equivalent to:
slStrings.AddObject('Zebra',TObject(0));
slStrings.AddObject('Zebra',TObject(1));
slStrings.AddObject('Bat',TObject(0));
slStrings.AddObject('Bat',TObject(2));
slStrings.AddObject('Cat',TObject(0));
slStrings.AddObject('Cat',TObject(3));
slStrings.AddObject('Hat',TObject(0));
slStrings.AddObject('Hat',TObject(4));
slStrings.AddObject('Aat',TObject(0));
slStrings.AddObject('Aat',TObject(5));
Did you actually mean to write this:
slStrings.AddObject('Zebra',TObject(1));
slStrings.AddObject('Bat',TObject(2));
slStrings.AddObject('Cat',TObject(3));
slStrings.AddObject('Hat',TObject(4));
slStrings.AddObject('Aat',TObject(5));
the Solution was this:
procedure TestFind;
var
i, iIndex, iStringSize :integer;
slStrings : TStringlist;
begin
slStrings := TStringList.Create;
slStrings.Sorted := False;
slStrings.AddObject('Zebra',TObject(1));
slStrings.AddObject('Bat',TObject(2));
slStrings.AddObject('Cat',TObject(3));
slStrings.AddObject('Hat',TObject(4));
slStrings.AddObject('Zebra',TObject(6));
slStrings.AddObject('Aat',TObject(5));
slStrings.AddObject('Zebra',TObject(7));
slStrings.sorted := True;
if slStrings.Find('Bat',iIndex) then
begin
//find lowest position of string matching found string
while iIndex > 0 do
begin
if (g_slVials.Strings[iIndex] = g_slVials.Strings[iIndex-1]) then
iIndex := iIndex - 1
else
break;
end;
iStringSize := slStrings.Count;
while iIndex < iStringSize -1 do //check for more matching strings in higher range
begin
if (g_slVials.Strings[iIndex] = g_slVials.Strings[iIndex+1]) then
begin
i := ObjectToInt(slStrings.Objects[iIndex]) ;
AddMemoData ('Stringlist Found at Position: ' + inttoStr(i) + ' Current index position is: ' + inttoStr(iIndex), false);
inc(iIndex);
end else
break;
end;
i := ObjectToInt(slStrings.Objects[iIndex]) ;
AddMemoData ('Stringlist Found at Position: ' + inttoStr(i) + ' Current index position is: ' + inttoStr(iIndex), false);
end;
end;
this allows me to find all matching strings and return their index position
Related
Im having problems with this code, I have two file of char, one is filed with information about books, and the other is empty, i have to write in SAL some information from S and then show the total of how many books match the first 2 digits of the code and how many are R and how many are T. The code, does write the information form S to Sal, but when its supposed to show the totals it appears ERORR 100 on screen. I read about it and it says that it is a problem with 'Disk read error' and that *This error typically occurs, if you "seed" a non-existent record of a typed file and try to read/write it. *, i really dont undertand.
I've benn trying to figure it out, but I haven't been able to. I notice that if I dont put 'WHILE NOT EOF(S) DO' the error does not appear, but of course i need the while, if someone is able to point out my mistakes i would really apreciate it.
This is the code:
uses crt;
var
i : byte;
s,sal: file of char;
v,l1,l2: char;
cs,cn,cl: integer;
pn,ps,tot: integer;
BEGIN
cs:=0; cn:=0; i:=0; cl:=0;
Assign (s, 'C:\Users\te\Documents\s.txt');
{$I-}
Reset (s);
{$I+}
if IOResult <> 0 then
begin
writeln('Error');
halt(2);
end;
Assign (sal, 'C:\Users\te\Documents\sal.txt');
{$I-}
Rewrite (sal);
IOResult;
{$I+}
if IOResult <> 0 then
halt(2);
writeln('Please write the code of the book, only 2 digits');
read(L1);read(L2);
read(s,v);
while (not eof(s)) do
begin
for i:=1 to 2 do
read(s,v);
if (v = '0') then
begin
read(s,v);
if (v = '1') or (v = '2') then
begin
for i:=1 to 5 do
read(s,v);
if (v = 'R') then
begin
read(s,v);
cs:= cs + 1;
end
else
begin
if (v = 'T') then
begin
cn:= cn + 1;
read(s,v);
end;
end;
while (v <> '-') do
read(s,v);
while (v = '-') do
read(s,v);
if (v = L1) then
begin
write(sal, v);
read(s,v);
if (v = L2) then
begin
write(sal,v);
read(s,v);
cl:= cl + 1;
end;
end;
while ( v <> '/') do
begin
write(sal,v);
read(s,v);
end;
write(sal, '-');
end
else
begin
for i:= 1 to 5 do
read(s,v);
if (v = 'R') then
cs:= cs + 1
else
cn:= cn + 1;
if (v = L1) then
read(s,v);
if (v = L2) then
begin
cl:= cl + 1;
read(s,v);
end;
end;
end
else
begin
for i:= 1 to 5 do
read(s,v);
if (v = 'R') then
cs:= cs + 1
else
cn:= cn + 1;
if (v = L1) then
read(s,v);
if (v = L2) then
begin
cl:= cl + 1;
read(s,v);
end;
end;
end;
tot:= cs + cn;
ps:= (cs * 100) div tot;
pn:= (cn * 100) div tot;
writeln('TOTAL ',cl);
writeln();
writeln(ps,'% and',pn,'%');
The file S content:
02022013Rto kill a mockingbird-1301/02012014Tpeter pan-1001/02032013Thowto-2301/02012012Tmaze runner-1001/02012012Tmaze runner-1001/02012012Tmaze runner-1001/$
I really just need someone else's point of view on this code, I think maybe the algorithm is flawed.
Thanks
(After your edit, i see that your code now compiles w/o error in FPC, so I'm glad you've managed to fix the error yourself)
As this is obviously coursework, I'm not going to fix your code for you and in any case the wayEven so, I'm afraid you are going about this is completely wrong.
Basically, the main thing wrong with your code is that you are trying to control what happens as your read the source file character by character. Quite frankly, that's a hopeless way of trying to do it, because it makes the execution flow unnecessarily complicated and littered with ifs, buts and loops. It also requires you to keep mental track of what you are trying to do at any given step, and the resulting code is inherently not self-documenting - imagine if you came back to your code in six months, could you tell at a glance how it works and what it does? I certsinly couldn't personally.
You need to break the task down in a different way. Instead of analysing the problem from the bottom up ("If I read this character next, then what I need to do next is ...') do it from the top down: Although your input file is a file of char, it contains a series of strings, separated by a / character and finally terminated by a $ (but this terminator does not really matter). So what you need to do is to read these strings one-by-one; once you've got one, check whether it's the one you're looking for: if it is. process it however you need to, otherwise read the next one until you reach the end of the file.
Once you have successfully read one of the book strings, you can then split it up into the various fields it's composed of. The most useful function for doing this splitting is probably Copy, which lets you extract substrings from a string - look it up in the FPC help. I've included functions ExtractTitle and ExtractPreamble which show you what you need to do to write similar functions to extract the T/R code and the numeric code which follows the hyphen. Btw, if you need to ask a similar q in the future, it would be very helpful if you include a description of the layout and meaning of the various fields in the file.
So, what I'm going to show you is how to read the series of strings in your S.Txt by building them character-by-character. In the code below, I do this using a function GetNextBook which I hope is reasonable self-explanatory. The code uses this function in a while loop to fill the BookRecord string variable. Then, it simply writes the BookRecord to the console. What your code should do, of course, is to process the BookRecord contents to see if it is the one you are looking for and then do whether the remainder of your task is.
I hope you will agree that the code below is a lot clearer, a lot shorter and will be a lot easier to extend in future than the code in your q. They key to structuring a program this way is to break the program's task into a series of functions and procedures which each perform a single sub-task. Writing the program that way makes it easier to "re-wire" the program to change what it does, without having to rewrite the innards of the functions/procedures.
program fileofcharproject;
uses crt;
const
sContents = '02022013Rto kill a mockingbird-1301/02012014Tpeter pan-1001/02032013Thowto-2301/02012012Tmaze runner-1001/02012012Tmaze runner-1001/02012012Tmaze runner-1001/$';
InputFileName = 'C:\Users\MA\Documents\S.Txt';
OutputFileName = 'C:\Users\MA\Documents\Sal.Txt';
type
CharFile = File of Char; // this is to permit a file of char to be used
// as a parameter to a function/procedure
function GetNextBook(var S : CharFile) : String;
var
InputChar : Char;
begin
Result := '';
InputChar := Chr(0);
while not Eof(S) do begin
Read(S, InputChar);
// next, check that the char we've read is not a '/'
// if it is a '/' then exit this while loop
if (InputChar <> '/') then
Result := Result + InputChar
else
Break;
end;
end;
function ExtractBookTitle(BookRecord : String) : String;
var
p : Integer;
begin
Result := Copy(BookRecord, 10, Length(BookRecord));
p := Pos('-', Result);
if p > 0 then
Result := Copy(Result, 1, p - 1);
end;
procedure AddToOutputFile(var OutputFile : CharFile; BookRecord : String);
var
i : Integer;
begin
for i := 1 to Length(BookRecord) do
write(OutputFile, BookRecord[i]);
write(OutputFile, '/');
end;
function ExtractPreamble(BookRecord : String) : String;
begin
Result := Copy(BookRecord, 1, 8);
end;
function TitleMatches(PartialTitle, BookRecord : String) : Boolean;
begin
Result := Pos(PartialTitle, ExtractBookTitle(BookRecord)) > 0;
end;
var
i : Integer; //byte;
s,sal: file of char;
l1,l2: char;
InputChar : Char;
BookFound : Boolean;
cs,cn,cl: integer;
pn,ps,tot: integer;
Contents : String;
BookRecord : String;
PartialTitle : String;
begin
// First, create S.Txt so we don't have to make any assumptions about
// its contents
Contents := sContents;
Assign(s, InputFileName);
Rewrite(s);
for i := 1 to Length(Contents) do begin
write(s, Contents[i]); // writes the i'th character of Contents to the file
end;
Close(s);
cs:=0; cn:=0; i:=0; cl:=0;
// Open the input file
Assign (s, InputFileName);
{$I-}
Reset (s);
{$I+}
if IOResult <> 0 then
begin
writeln('Error');
halt(2);
end;
// Open the output file
Assign (sal, OutputFileName);
{$I-}
Rewrite (sal);
IOResult;
{$I+}
if IOResult <> 0 then
halt(2);
// the following reads the BookRecords one-by-one and copies
// any of them which match the partial title to sal.txt
writeln('Enter part of a book title, followed by [Enter]');
readln(PartialTitle);
while not Eof(s) do begin
BookRecord := GetNextBook(S);
writeln(BookRecord);
writeln('Preamble : ', ExtractPreamble(BookRecord));
writeln('Title : ', ExtractBookTitle(BookRecord));
if TitleMatches(PartialTitle, BookRecord) then
AddToOutputFile(sal, BookRecord);
end;
// add file '$' to sal.txt
write(sal, '$');
Close(sal);
Close(s);
writeln('Done, press any key');
readln;
end.
I have two files - one contains a number of short strings (that I call Items) and the other contains the IDs for these short strings. I also have a number of other files, each of which contains a very long string that is broken up into thousands of smaller strings by means of line breaks. I need to find the number of times each short string ("Item") occurs in each of the large string files, as well as the starting and ending position for each hit.
My first task is to remove the line breaks in the large files so that the hits do not straddle across two or more smaller strings, and then find the number of occurrences and start and end positions of each short string in the large strings, and report these results using the ID numbers for each short string.
I am getting a EInOutError (Access Denied) error apparently at the ReWrite(ResultFile) line (in the bottom half of the second procedure in the code below). Not sure why. I can see the file created for the results of the first long string, but it is blank. Here is the code; pretty simple and straightforward, actually. Thanks.
procedure TForm1.OpenStrCmdBtnClick(Sender: TObject);
begin
if OpenDialog1.execute then OpenStrEditBx.Text := OpenDialog1.FileName
else ShowMessage('Cannot open file!');
end;
procedure TForm1.FindItemfCmdBtnClick(Sender: TObject);
var
I, LenItem, NumTimes, offset: integer;
Extension, FileName, Dir, Str, Item, ID: string;
TempList, IDList, ItemList: TStringList;
searchResult: TSearchRec;
ResultFile: TextFile;
begin
IDList := TStringList.Create;
ItemList := TStringList.Create;
IDList.LoadFromFile('D:\...\IDs.txt');
ItemList.LoadFromFile('D:\...\Items.txt');
try
Dir := ExtractFilePath(OpenStrEditBx.Text);
//concatenate each line in each str sequence to get full string
if FindFirst(Dir + '*.txt', faAnyFile, searchResult) = 0 then
repeat
Extension := ExtractFileExt(OpenStrEditBx.Text);
FileName := StringReplace(searchResult.Name, Extension, '', [rFReplaceAll, rFIgnoreCase]);//remove file extension to get only file name
TempList := TStringList.Create;
TempList.LoadFromFile(Dir + searchResult.Name);
Str := '';
for I := 1 to TempList.Count-1 do // I <> 0 to ignore ID in first line
begin
Str := Str + TempList[I];
ProgressBar1.Position := (ProgressBar1.Position + 10) mod ProgressBar1.Max;
end;
TempList.Free;
//Find number and location of occurrences of each Item
for I := 0 to ItemList.Count-1 do
begin
Item := ItemList[I];
LenItem := Length(Item);
ID := IDList[I];
NumTimes := 0;
Offset := PosEx(Item, Str, 1);
AssignFile(ResultFile, 'D:\...\' + FileName + '.txt');
ReWrite(ResultFile);
while Offset <> 0 do
begin
inc(NumTimes);
if NumTimes > 0 then
WriteLn(ResultFile, 'The ' + IntToStr(NumTimes) + 'th occurrence of ' + 'ID# ' + ID + ' is from Position# ' + IntToStr(Offset) + ' to Position# ' + IntToStr(Offset + LenItem- 1) + ' in ' + FileName);
Offset := PosEx(Item, Str, Offset + LenItem);
end;
WriteLn(ResultFile, 'ID# ' + ID + ' occurs ' + IntToStr(NumTimes) + ' number of times in ' + FileName);
end;
CloseFile(ResultFile);
ShowMessage(FileName + ' done!');
until FindNext(searchResult) <> 0;
FindClose(searchResult);
finally
IDList.Free;
ItemList.Free;
end;
end;
I am attempting to write a comment stripper in pascal. I run my code and pass it a C source code file and it strips the comments from the file and prints the result to terminal.
I am fairly new to pascal. I am getting some very strange output and I cannot figure out why. The code checks for comments line by line and prints characters one at a time. The comment stripper is printing what seems to be random characters whenever it reaches the start of a new line. I am using pascals Write(Str[i]) function to print characters and WriteLn() once the end of a line is reached.
I have no idea why im receiving weird output. I am running Linux Mint and can compile and run my code, but I receive this strange output. I also tried running my code on a Mac and received a run-time error:
Program Path: ./Assignment1
File Name: lol.c
Runtime error 2 at $00011532
$00011532
$0002F7F6
$000113FD
$00011328
$00000002
Here is my code
program Assignment1;
uses
Sysutils;
var UserFile : TextFile;
TString : String;
OLine : String;
i : integer;
isComment : boolean;
skip : boolean;
begin
{$I+}
WriteLn('Program Path: ', ParamStr(0));
WriteLn('File Name: ', ParamStr(1));
Assign(UserFile, ParamStr(1) + '.c');
Reset(UserFile);
isComment := false;
skip := true;
Repeat
Readln(UserFile, TString);
for i:= 0 to ((Length(TString) - 1)) do
begin
if(skip) then
begin
skip := false;
continue;
end;
if(isComment = false) Then
begin
if(TString[i] = '/') Then
begin
if(TString[i+1] = '/') Then
begin
break;
end
else if(TString[i+1] = '*') Then
begin
isComment := true;
skip := true;
continue;
end;
end;
Write(TString[i]);
if(i = Length(TString) - 1) Then
begin
Write(TString[i + 1]);
end;
end
else
begin
if(TString[i] = '*') Then
begin
if(TString[i + 1] = '/') Then
begin
isComment := false;
skip := true;
continue;
end;
end;
end;
end;
WriteLn();
Until Eof(UserFile);
end.
I receive random characters which range from standard keyboard symbols to unicode blocks such as the ones found here.
Does anyone have any suggestions?
As 500 - Internal Server Error says, Pascal strings are 1-based. Your references to slot zero are returning garbage. If these are 256-byte strings you're getting the length code, I don't recall the memory layout of the pointer-based strings to know what you're getting in that case. You're also losing the last character of every string because of this.
Beyond that I see a definite bug: Look at what happens with a line ending in /
I also do not understand this:
if(i = Length(TString) - 1) Then
begin
Write(TString[i + 1]);
end;
It seems to me it's writing an extra character but I'm not sure.
I'm trying to code a procedure which goes through a record of numbers and finds which one is highest, the code currently is below. The issue I have is that it just seems to list the last score on the record (not the highest). Any help is greatly appreciated.
Procedure FindTopScore(Var TopScores : TTopScores);
Var
Count : Integer;
Highest : Integer;
Name: String;
Begin
For Count := 1 to MaxSize Do
If TopScores[Count].Score > Highest Then
Highest := TopScores[Count].Score;
Name := TopScores[Count].Name;
Writeln('Higest score is by ' ,TopScores[Count].Name, ' of ', TopScores[Count].Score);
End;
You're not outputting Highest, but TopScores[Count].Score. Just use
Writeln('Highest is ', Highest, ' for ', Name);
Also you should put the name into a variable Name inside the if-statement (it actually is outside).
Addon: If you want all names in case of a tie you can use e.g. the following code
Highest := 0;
For Count := 1 to MaxSize Do Begin
If TopScores[Count].Score = Highest Then Begin
Name := Name + ' and ' + TopScores[Count].Name;
End;
If TopScores[Count].Score > Highest Then Begin
Highest := TopScores[Count].Score;
Name := TopScores[Count].Name;
End;
End;
In addition to Howard's answer, set '0' to 'Highest' before beginning the loop. Being uninitialized, it is having an arbitrary value, probably higher then the highest score.
In addition to the accepted answer, make sure you turn on your warnings and hints, and you'll see:
testhighest.pp(16,39) Warning: Local variable "Highest" does not seem to be initialized
which is the
If TopScores[Count].Score > Highest Then
line
I want to develop a setup package for conditionally upgrading an existing package. I want to check the existing software version against to-be-installed version. In order to do that, I have to compare the version strings.
How can I convert the string value to a numerical value in a Inno setup script?
RegQueryStringValue(HKEY_LOCAL_MACHINE, 'Software\Blah blah', 'Version', version)
version = 'V1.R2.12';
numVersion := ??string_to_numerical_value??(version);
This is a little more tricky, as you would want to handle versions like 'V1.R2.12' and 'V0.R15.42' correctly - with the simple conversion in the other answer you would get 1212 and 1542, which would not compare the way you would expect.
You need to decide how big each part of the version number can be, and multiply the parts by that value to get a correct end number. Something like this:
[Code]
function string_to_numerical_value(AString: string; AMaxVersion: LongWord): LongWord;
var
InsidePart: boolean;
NewPart: LongWord;
CharIndex: integer;
c: char;
begin
Result := 0;
InsidePart := FALSE;
// this assumes decimal version numbers !!!
for CharIndex := 1 to Length(AString) do begin
c := AString[CharIndex];
if (c >= '0') and (c <= '9') then begin
// new digit found
if not InsidePart then begin
Result := Result * AMaxVersion + NewPart;
NewPart := 0;
InsidePart := TRUE;
end;
NewPart := NewPart * 10 + Ord(c) - Ord('0');
end else
InsidePart := FALSE;
end;
// if last char was a digit the last part hasn't been added yet
if InsidePart then
Result := Result * AMaxVersion + NewPart;
end;
You can test this with the following code:
function InitializeSetup(): Boolean;
begin
if string_to_numerical_value('V1.R2.12', 1) < string_to_numerical_value('V0.R15.42', 1) then
MsgBox('Version ''V1.R2.12'' is not as recent as version ''V0.R15.42'' (false)', mbConfirmation, MB_OK);
if string_to_numerical_value('V1.R2.12', 100) > string_to_numerical_value('V0.R15.42', 100) then
MsgBox('Version ''V1.R2.12'' is more recent than version ''V0.R15.42'' (true)', mbConfirmation, MB_OK);
Result := FALSE;
end;
Whether you pass 10, 100 or 1000 for AMaxVersion depends on the number and range of your version number parts. Note that you must not overflow the LongWord result variable, which has a maximum value of 2^32 - 1.
I haven't tried that (and my Pascal knowledge is a bit rusty), but something like the following should work:
function NumericVersion(s: String): Integer;
var
i: Integer;
s1: String;
begin
s1 := '';
for i := 0 to Length(s)-1 do
if (s[i] >= '0') and (s[i] <= '9') then
s1 := s1 + s[i];
Result := StrToIntDef(s1, 0);
end;
Please not that you'll have to play with the start and end value for i as I'm not sure whether it is zero-based or not (s[0] may contain the length of the string if it is a "Pascal String").
I've implemented two version strings (actually one string and one dword value) in the registry to overcome complexity.
displayversion="v1.r1.0"
version="10100" (=1*10^4 + 1*10^2 + 0*10^0)
That's simple. Though not an answer to this question, however one might think the other way around when faced with complexity, which could be avoided in a simpler way.