How should I convert this while loop into a for loop?
const
TheRightWord = 'hello';
MaximumTries = 3;
var
NTries : integer;
AWord : string;
begin
NTries := 1;
AWord := ' ';
while (AWord <> TheRightWord) and (NTries <= MaximumTries) do
I thought this would be the answer:
for (AWord <> TheRightWord) and (NTries <= MaximumTries) do
Must I just put a for inplace of the while? Or is it for i := 1 to 3 do?
for numtries := 1 to maxnumtries do begin
if AWord = TheRightWord then
break;
...
How to determine success or failure when exiting the loop (or, for that matter, how to iterate through different values of "AWord") is an exercise for the student :-)
Related
This question already has answers here:
Converting decimal/integer to binary - how and why it works the way it does?
(6 answers)
Closed 4 years ago.
I have done some Example to convert a string to binary but i couldn't find a way to walk on each character in the string and complete the whole calculations process and then step to the next character in the string, Here is my code:
var i,j, rest, results :integer;
restResult : string;
begin
results := 1;
for i := 1 to length(stringValue) do
begin
while (results > 0) do
begin
results := ord(stringValue[i]) div 2;
rest := ord(stringValue[i]) mod 2;
restResult := restResult + inttostr(rest);
end;
end;
// Get The Rests Backwards
for i := length(restResult) downto 1 do
begin
result := result + restResult[i];
end;
The application always get into infinite loop, any suggestions?
Your results := ord(stringValue[i]) div 2; remains the same, because stringValue[i] does not change, so while loop is infinite.
To solve this mistake:
for i := 1 to length(stringValue) do
begin
t := ord(stringValue[i]);
repeat
restResult := restResult + inttostr(t mod 2);
t := t div 2;
until t = 0;
end;
But note that you cannot divide resulting string into pieces for distinct chars, because length of binary representation will vary depending on char itself.
This is example of code with fixed length for representation of char (here AnsiChar):
function AnsiStringToBinaryString(const s: AnsiString): String;
const
SBits: array[0..1] of string = ('0', '1');
var
i, k, t: Integer;
schar: string;
begin
Result := '';
for i := 1 to Length(s) do begin
t := Ord(s[i]);
schar := '';
for k := 1 to 8 * SizeOf(AnsiChar) do begin
schar := SBits[t mod 2] + schar;
t := t div 2
end;
Result := Result + schar;
end;
end;
'#A z': (division bars are mine)
01000000|01000001|00100000|01111010
# A space z
I am building a stringlist from an ADO query, in the query it is much faster to return sorted results and then add them in order. this gives me an already sorted list and then calling either Sort or setting sorted true costs me time as the Quicksort algorithm does not preform well on an already sorted list. Is there some way to set the TStringList to use the Binary search without running the sort?
before you ask I don't have access to the CustomSort attribute.
I am not sure I understand what you are worried about, assuming the desired sort order of the StringList is the same as the ORDER BY of the AdoQuery.
Surely the thing to do is to set Sorted on your StringList to True while it is still empty and then insert the rows from the AdoQuery. That way, when the StringList is about to Add an entry, it will search for it using IndexOf, which will in turn use Find, which does a binary search, to check for duplicates. But using Add in this way does not involve a quicksort because the StringList is already treating itself as sorted.
In view of your comments and your own answer I ran the program below through the Line Timer profiler in NexusDB's Quality Suite. The result is that although there are detectable differences in execution speed using a binary search versus TStringList.IndexOf, they are nothing to do with the use (or not) of TStringList's QuickSort. Further, the difference is explicable by a subtle difference between how the binary search I used and the one in TStringList.Find work - see Update #2 below.
The program generates 200k 100-character strings and then inserts them into a StringList. The StringList is generated in two ways, first with Sorted set to True before any strings are added and then with Sorted set to True only after the strings have been added. StringList.IndexOf and your BinSearch is then used to look up each of the strings which has been added. The results are as follows:
Line Total Time Source
80 procedure Test;
119 0.000549 begin
120 2922.105618 StringList := GetList(True);
121 2877.101652 TestIndexOf;
122 1062.461975 TestBinSearch;
123 29.299069 StringList.Free;
124
125 2970.756283 StringList := GetList(False);
126 2943.510851 TestIndexOf;
127 1044.146265 TestBinSearch;
128 31.440766 StringList.Free;
129 end;
130
131 begin
132 Test;
133 end.
The problem I encountered is that your BinSearch never actually returns 1 and the number of failures is equal to the number of strings searched for. If you can fix this, I'll be happy to re-do the test.
program SortedStringList2;
[...]
const
Rows = 200000;
StrLen = 100;
function ZeroPad(Number : Integer; Len : Integer) : String;
begin
Result := IntToStr(Number);
if Length(Result) < Len then
Result := StringOfChar('0', Len - Length(Result)) + Result;
end;
function GetList(SortWhenEmpty : Boolean) : TStringList;
var
i : Integer;
begin
Result := TStringList.Create;
if SortWhenEmpty then
Result.Sorted := True;
for i := 1 to Rows do
Result.Add(ZeroPad(i, StrLen));
if not SortWhenEmpty then
Result.Sorted := True;
end;
Function BinSearch(slList: TStringList; sToFind : String) : integer;
var
i, j, k : integer;
begin
try
i := slList.Count div 2;
k := i;
if i = 0 then
begin
Result := -1;
// SpendLog('BinSearch List Empty, Exiting...');
exit;
end;
while slList.Strings[i] <> sToFind do
begin
if CompareText(slList.Strings[i], sToFind) < 0 then
begin
j := i;
k := k div 2;
i := i + k;
if j=i then
break;
end else
if CompareText(slList.Strings[i], sToFind) > 0 then
begin
j := i;
k := k div 2;
i := i - k;
if j=i then
break;
end else
break;
end;
if slList.Strings[i] = sToFind then
result := i
else
Result := -1;
except
//SpendLog('<BinSearch> Exception: ' + ExceptionMessage + ' At Line: ' + Analysis.LastSourcePos);
end;
end;
procedure Test;
var
i : Integer;
StringList : TStringList;
procedure TestIndexOf;
var
i : Integer;
Index : Integer;
Failures : Integer;
S : String;
begin
Failures := 0;
for i := 1 to Rows do begin
S := ZeroPad(i, StrLen);
Index := StringList.IndexOf(S);
if Index < 0 then
Inc(Failures);
end;
Assert(Failures = 0);
end;
procedure TestBinSearch;
var
i : Integer;
Index : Integer;
Failures : Integer;
S : String;
begin
Failures := 0;
for i := 1 to Rows do begin
S := ZeroPad(i, StrLen);
Index := BinSearch(StringList, S);
if Index < 0 then
Inc(Failures);
end;
//Assert(Failures = 0);
end;
begin
StringList := GetList(True);
TestIndexOf;
TestBinSearch;
StringList.Free;
StringList := GetList(False);
TestIndexOf;
TestBinSearch;
StringList.Free;
end;
begin
Test;
end.
Update I wrote my own implementation of the search algorithm in the Wikipedia article https://en.wikipedia.org/wiki/Binary_search_algorithm as follows:
function BinSearch(slList: TStringList; sToFind : String) : integer;
var
L, R, m : integer;
begin
L := 0;
R := slList.Count - 1;
if R < L then begin
Result := -1;
exit;
end;
m := (L + R) div 2;
while slList.Strings[m] <> sToFind do begin
m := (L + R) div 2;
if CompareText(slList.Strings[m], sToFind) < 0 then
L := m + 1
else
if CompareText(slList.Strings[m], sToFind) > 0 then
R := m - 1;
if L > R then
break;
end;
if slList.Strings[m] = sToFind then
Result := m
else
Result := -1;
end;
This seems to work correctly, and re-profiling the test app using this gave these results:
Line Total Time Source
113 procedure Test;
153 0.000490 begin
154 3020.588894 StringList := GetList(True);
155 2892.860499 TestIndexOf;
156 1143.722379 TestBinSearch;
157 29.612898 StringList.Free;
158
159 2991.241659 StringList := GetList(False);
160 2934.778847 TestIndexOf;
161 1113.911083 TestBinSearch;
162 30.069241 StringList.Free;
On that showing, a binary search clearly outperforms TStringList.IndexOf and contrary to my expectations it makes no real difference whether TStringList.Sorted is set to True before or after the strings are added.
Update#2 it turns out that the reason BinSearch is faster than TStringList.IndexOf is purely because BinSearch uses CompareText whereas TStringList.IndexOf uses AnsiCompareText (via .Find). If I change BinSearch to use AnsiCompareText, it becomes 1.6 times slower than TStringList.IndexOf!
I was about to suggest using an interposer class to directly change the FSorted field without calling its setter method which as a side effect calls the Sort method. But looking at the implementation of TStringList in Delphi 2007, I found that Find will always do a binary search without checking the Sorted property. This will, of course fail, if the list items aren't sorted, but in your case they are. So, as long as you remember to call Find rather than IndexOf, you don't need to do anything.
in the end I just hacked up a binary search to check the stringlist like an array:
Function BinSearch(slList: TStringList; sToFind : String) : integer;
var
i, j, k : integer;
begin
try
try
i := slList.Count div 2;
k := i;
if i = 0 then
begin
Result := -1;
SpendLog('BinSearch List Empty, Exiting...');
exit;
end;
while slList.Strings[i] <> sToFind do
begin
if CompareText(slList.Strings[i], sToFind) < 0 then
begin
j := i;
k := k div 2;
i := i + k;
if j=i then
break;
end else
if CompareText(slList.Strings[i], sToFind) > 0 then
begin
j := i;
k := k div 2;
i := i - k;
if j=i then
break;
end else
break;
end;
if slList.Strings[i] = sToFind then
result := i
else
Result := -1;
except
SpendLog('<BinSearch> Exception: ' + ExceptionMessage + ' At Line: ' + Analysis.LastSourcePos);
end;
finally
end;
end;
I'll clean this up later if needed.
source array(4 bytes)
[$80,$80,$80,$80] =integer 0
[$80,$80,$80,$81] = 1
[$80,$80,$80,$FF] = 127
[$80,$80,$81,$01] = 128
need to convert this to integer.
below is my code and its working at the moment.
function convert(b: array of Byte): Integer;
var
i, st, p: Integer;
Negative: Boolean;
begin
result := 0;
st := -1;
for i := 0 to High(b) do
begin
if b[i] = $80 then Continue // skip leading 80
else
begin
st := i;
Negative := b[i] < $80;
b[i] := abs(b[i] - $80);
Break;
end;
end;
if st = -1 then exit;
for i := st to High(b) do
begin
p := round(Power(254, High(b) - i));
result := result + b[i] * p;
result := result - (p div 2);
end;
if Negative then result := -1 * result
end;
i'm looking for a better function?
Update:
file link
https://drive.google.com/file/d/0ByBA4QF-YOggZUdzcXpmOS1aam8/view?usp=sharing
in uploaded file ID field offset is from 5 to 9
NEW:
Now i got into new problem which is decoding date field
Date field hex [$80,$8F,$21,$C1] -> possible date 1995-12-15
* in uploaded file date field offset is from 199 to 203
Just an example of some improvements as outlined by David.
The array is passed by reference as a const.
The array is fixed in size.
The use of floating point calculations are converted directly into a constant array.
Const
MaxRange = 3;
Type
TMySpecial = array[0..MaxRange] of Byte;
function Convert(const b: TMySpecial): Integer;
var
i, j: Integer;
Negative: Boolean;
Const
// Pwr[i] = Round(Power(254,MaxRange-i));
Pwr: array[0..MaxRange] of Cardinal = (16387064,64516,254,1);
begin
for i := 0 to MaxRange do begin
if (b[i] <> $80) then begin
Negative := b[i] < $80;
Result := Abs(b[i] - $80)*Pwr[i] - (Pwr[i] shr 1);
for j := i+1 to MaxRange do
Result := Result + b[j]*Pwr[j] - (Pwr[j] shr 1);
if Negative then
Result := -Result;
Exit;
end;
end;
Result := 0;
end;
Note that less code lines is not always a sign of good performance.
Always measure performance before optimizing the code in order to find real bottlenecks.
Often code readability is better than optimizing over the top.
And for future references, please tell us what the algorithm is supposed to do.
Code for testing:
const
X : array[0..3] of TMySpecial =
(($80,$80,$80,$80), // =integer 0
($80,$80,$80,$81), // = 1
($80,$80,$80,$FF), // = 127
($80,$80,$81,$01)); // = 128
var
i,j: Integer;
sw: TStopWatch;
begin
sw := TStopWatch.StartNew;
for i := 1 to 100000000 do
for j := 0 to 3 do
Convert(X[j]);
WriteLn(sw.ElapsedMilliseconds);
ReadLn;
end.
I'm coding this function and for the line where I set result := -10 compiler gives me a warning saying such value is never asigned. Is there something wrong about my logic?
function combine (m1, m2 : string) : integer;
var
dash : integer;
distinct : integer;
i : integer;
begin
distinct := 0;
dash := -1;
for i := 0 to Length(m1)-1 do
begin
if m1[i] = m2[i] then
begin
distinct := distinct+1;
dash := i;
if distinct > 1 then
result:= -10;
end;
end;
result := dash;
end;
The value is never assigned because you set the value of the result to dash in the last line.
you can change your code from
if distinct > 1 then
result:= -10;
to
if distinct > 1 then
dash:= -10;
I have a BIG problem here and do not even know how to start...
In short explanation, I need to know if a number is in a set of results from a random combination...
Let me explain better: I created a random "number" with 3 integer chars from 1 to 8, like this:
procedure TForm1.btn1Click(Sender: TObject);
var
cTmp: Char;
sTmp: String[3];
begin
sTmp := '';
While (Length(sTmp) < 3) Do
Begin
Randomize;
cTmp := IntToStr(Random(7) + 1)[1];
If (Pos(cTmp, sTmp) = 0) Then
sTmp := sTmp + cTmp;
end;
edt1.Text := sTmp;
end;
Now I need to know is some other random number, let's say "324" (example), is in the set of results of that random combination.
Please, someone can help? A link to get the equations to solve this problem will be enough...
Ok, let me try to add some useful information:
Please, first check this link https://en.wikipedia.org/wiki/Combination
Once I get some number typed by user, in an editbox, I need to check if it is in the set of this random combination: S = (1..8) and k = 3
Tricky, hum?
Here is what I got. Maybe it be usefull for someone in the future. Thank you for all people that tried to help!
Function IsNumOnSet(const Min, Max, Num: Integer): Boolean;
var
X, Y, Z: Integer;
Begin
Result := False;
For X := Min to Max Do
For Y := Min to Max Do
For Z := Min to Max Do
If (X <> Y) and (X <> Z) and (Y <> Z) Then
If (X * 100 + Y * 10 + Z = Num) Then
Begin
Result := True;
Exit;
end;
end;
You want to test whether something is a combination. To do this you need to verify that the putative combination satisfies the following conditions:
Each element is in the range 1..N and
No element appears more than once.
So, implement it like this.
Declare an array of counts, say array [1..N] of Integer. If N varies at runtime you will need a dynamic array.
Initialise all members of the array to zero.
Loop through each element of the putative combination. Check that the element is in the range 1..N. And increment the count for that element.
If any element has a count greater than 1 then this is not a valid combination.
Now you can simplify by replacing the array of integers with an array of booleans but that should be self evident.
You have your generator. Once your value is built, do something like
function isValidCode( Digits : Array of Char; Value : String ) : Boolean;
var
nI : Integer;
begin
for nI := 0 to High(Digits) do
begin
result := Pos(Digits[nI], Value ) > 0;
if not result then break;
end;
end;
Call like this...
isValidCode(["3","2","4"], RandomValue);
Note : it works only because you have unique digits, the digit 3 is only once in you final number. For something more generic, you'll have to tweak this function. (testing "3","3","2" would return true but it would be false !)
UPDATED :
I dislike the nested loop ^^. Here is a function that return the nTh digit of an integer. It will return -1 if the digits do not exists. :
function TForm1.getDigits(value : integer; ndigits : Integer ) : Integer;
var
base : Integer;
begin
base := Round(IntPower( 10, ndigits-1 ));
result := Trunc( value / BASE ) mod 10;
end;
nDigits is the digits number from right to left starting at 1. It will return the value of the digit.
GetDigits( 234, 1) returns 4
GetDigits( 234, 2) returns 3
GetDigits( 234, 3) returns 2.
GetDigits( 234, 4) returns 0.
Now this last function checks if a value is a good combination, specifying the maxdigits you're looking for :
function isValidCombination( value : integer; MinVal, MaxVal : Integer; MaxDigits : Integer ) : Boolean;
var
Buff : Array[0..9] of Integer;
nI, digit: Integer;
begin
ZeroMemory( #Buff, 10*4);
// Store the count of digits for
for nI := 1 to MaxDigits do
begin
digit := getDigits(value, nI);
Buff[digit] := Buff[digit] + 1;
end;
// Check if the value is more than the number of digits.
if Value >= Round(IntPower( 10, MaxDigits )) then
begin
result := False;
exit;
end;
// Check if the value has less than MaxDigits.
if Value < Round(IntPower( 10, MaxDigits-1 )) then
begin
result := False;
exit;
end;
result := true;
for nI := 0 to 9 do
begin
// Exit if more than One occurence of digit.
result := Buff[nI] < 2 ;
if not result then break;
// Check if digit is present and valid.
result := (Buff[nI] = 0) or InRange( nI, MinVal, MaxVal );
if not result then break;
end;
end;
Question does not seem too vague to me,
Maybe a bit poorly stated.
From what I understand you want to check if a string is in a set of randomly generated characters.
Here is how that would work fastest, keep a sorted array of all letters and how many times you have each letter.
Subtract each letter from the target string
If any value in the sorted int array goes under 0 then that means the string can not be made from those characters.
I made it just work with case insensitive strings but it can easily be made to work with any string by making the alphabet array 255 characters long and not starting from A.
This will not allow you to use characters twice like the other example
so 'boom' is not in 'b' 'o' 'm'
Hope this helps you.
function TForm1.isWordInArray(word: string; arr: array of Char):Boolean;
var
alphabetCount: array[0..25] of Integer;
i, baseval, position : Integer;
s: String;
c: Char;
begin
for i := 0 to 25 do alphabetCount[i] := 0; // init alphabet
s := UpperCase(word); // make string uppercase
baseval := Ord('A'); // count A as the 0th letter
for i := 0 to Length(arr)-1 do begin // disect array and build alhabet
c := UpCase(arr[i]); // get current letter
inc(alphabetCount[(Ord(c)-baseval)]); // add 1 to the letter count for that letter
end;
for i := 1 to Length(s) do begin // disect string
c := s[i]; // get current letter
position := (Ord(c)-baseval);
if(alphabetCount[position]>0) then // if there is still latters of that kind left
dec(alphabetCount[position]) // delete 1 to the letter count for that letter
else begin // letternot there!, exit with a negative result
Result := False;
Exit;
end;
end;
Result := True; // all tests where passed, the string is in the array
end;
implemented like so:
if isWordInArray('Delphi',['d','l','e','P','i','h']) then Caption := 'Yup' else Caption := 'Nope'; //yup
if isWordInArray('boom',['b','o','m']) then Caption := 'Yup' else Caption := 'Nope'; //nope, a char can only be used once
Delphi rocks!
begin
Randomize; //only need to execute this once.
sTmp := '';
While (Length(sTmp) < 3) Do
Begin
cTmp := IntToStr(Random(7) + 1)[1]; // RANDOM(7) produces # from 0..6
// so result will be '1'..'7', not '8'
// Alternative: clmp := chr(48 + random(8));
If (Pos(cTmp, sTmp) = 0) Then
sTmp := sTmp + cTmp;
IF SLMP = '324' THEN
DOSOMETHING; // don't know what you actually want to do
// Perhaps SET SLMP=''; to make sure '324'
// isn't generated?
end;
edt1.Text := sTmp;
end;