Alternative to nested for-loop in Delphi - delphi

I came across the following (conceptually very simple) problem, and want to write code to do it, but am struggling. Let's say we have two rows of equal length, k. Each cell of each row can be either a 0 or a 1.
For e.g., consider the following row-pair, with k = 5: 01011, 00110
Now if the two rows could freely exchange values at each cell, there would be 2^5 possible combinations of row-pairs (some of which may not be unique). For instance, we could have 00010, 01111 as one possible row-pair from the above data. I want to write code in Delphi to list all the possible row-pairs. This is easy enough to do with a set of nested for-loops. However, if the value of k is known only at run-time, I'm not sure how I can use this approach for I don't know how many index variables I would need. I can't see how case statements will help either because I don't know the value of k.
I am hoping that there is an alternative to a nested for-loop, but any thoughts would be appreciated. Thanks.

Given two vectors A and B of length k, we can generate a new pair of vectors A1 and B1 by selectively choosing elements from A or B. Let our decision to choose from A or B be dictated by a bit vector S, also of length k. For i in [0..k), when Si is 0, store Ai in A1i and Bi in B1i. If Si is 1, then vice versa.
We can define that in Delphi with a function like this:
procedure GeneratePair(const A, B: string; S: Cardinal; out A1, B1: string);
var
k: Cardinal;
i: Cardinal;
begin
Assert(Length(A) = Length(B));
k := Length(A);
Assert(k <= 32);
SetLength(A1, k);
SetLength(B1, k);
for i := 1 to k do
if (S and (1 shl Pred(i))) = 0 then begin
A1[i] := A[i];
B1[i] := B[i];
end else begin
A1[i] := B[i];
B1[i] := A[i];
end;
end;
If we count in binary from 0 to 2k−1, that will give us a sequence of bit vectors representing all the possible combinations of exchanging or not-exchanging characters between A and B.
We can write a loop and use the above function to generate all 2k combinations:
A := '01011';
B := '00110';
for S := 0 to Pred(Round(IntPower(2, Length(A)))) do begin
GeneratePair(A, B, S, A1, B1);
writeln(A1, ', ', B1);
end;
That effectively uses one set of nested loops. The outer loop is the one from 0 to 31. The inner loop is the one inside the function from 1 to k. As you can see, we don't need to know the value of k in advance.

Now that, thanks to Rob, I understand the problem, I offer this recursive solution:
{$APPTYPE CONSOLE}
procedure Swap(var A, B: Char);
var
temp: Char;
begin
temp := A;
A := B;
B := temp;
end;
procedure Generate(const A, B: string; Index: Integer);
var
A1, B1: string;
begin
Assert(Length(A)=Length(B));
inc(Index);
if Index>Length(A) then // termination
Writeln(A, ', ', B)
else
begin // recurse
// no swap
Generate(A, B, Index);
//swap
A1 := A;
B1 := B;
Swap(A1[Index], B1[Index]);
Generate(A1, B1, Index);
end;
end;
begin
Generate('01011', '00110', 0);
Readln;
end.

Related

Compare multiple values at a time

I need to check if N values are equals.
var
A, B, C, D : Integer;
begin
...
if(A = B) and (B = C) and (C = D) then
ShowMessage('Same value');
end;
Is there a shorter way to compare N values?
I mean something like:
var
A, B, C, D : Integer;
begin
...
if SameValue([A, B, C, D]) then
ShowMessage('Same value');
end;
Well, the best you can achieve is basically your own suggestion.
You would implement this using an open array parameter:
function AllEqual(const AValues: array of Integer): Boolean;
var
i: Integer;
begin
for i := 1 to High(AValues) do
if AValues[i] <> AValues[0] then
Exit(False);
Result := True;
end;
The correctness of this implementation is obvious:
If the number of values in the array is 0 or 1, it returns True.
Otherwise, and in general, it returns False iff the array contains two non-equal values.
AValues[0] is only accessed if High(AValues) >= 1, in which case the 0th value exists.
A function like this one is straightforward to implement for ordinal types. For real types (floating-point values), it becomes much more subtle, at least if you want to compare the elements with epsilons (like the SameValue function does in the Delphi RTL). Indeed, then you get different behaviour depending on if you compare every element against the first element, or if you compare every element against its predecessor.
Andreas' answer is correct, I'd like to add a different approach though:
uses Math;
function AllEqual(const AValues: array of Integer): Boolean;
begin
Result := (MinIntValue(AValues) = MaxIntValue(AValues));
end;
function AllEqualF(const AValues: array of Double; Epsilon: Double): Boolean;
begin
Result := ((MaxValue(AValues)- MinValue(AValues)) <= Epsilon);
end;
There is quite simple and very fast equality comparison approach for ints without a need of additional method and stuff like this - it's Bitwise Operators
And of course, this could be put in a method with open array or so.
There are even 2 options (or maybe more), with second you also can replace "or" to "+" , OR (not both, it will ruin equality-test logic) you can replace "xor" to "-" (last case)
BUT the resulting condition length is not shorter than original (only the last case is same and all brackets/parenthesis are vital, except first xor/-), here is the testing code:
program Project1;{$APPTYPE CONSOLE}
uses Math; var a, b, c, d, x : Integer; s: string;
begin
Randomize;
repeat
x := Random(10) - 5;
a := x + Sign(Random() - 0.5);
b := x + Sign(Random() - 0.5);
c := x + Sign(Random() - 0.5);
d := x + Sign(Random() - 0.5);
Writeln(a, ' ', b, ' ', c, ' ', d);
Writeln((A = B) and (B = C) and (C = D));
Writeln(a or b or c or d = a and b and c and d);
Writeln(a xor b or (b xor c) or (c xor d) = 0);
Writeln(a - b or (b - c) or (c - d) = 0);
Readln(s);
until s <> '';
end.

Pascal's Triangle output alignment

So I've come up with the code to the values of the triangle itself. What I'm currently strugling is how to aligne/center the values that are printed. I tried many things but, I could use some help now. If anyone has an idea how this can be done feel free to share! Thank you
Program Tri_pas;
Uses Crt;
Var
linha,ordem,a,b: byte;
Function fat(X: byte): real; // factorial
Var fat1: real;
Begin
fat1:=1;
If X <= 1 Then
fat:=1
Else
Begin
Repeat
fat1:=(fat1 * X);
X:=(X - 1);
Until X <= 1;
fat:=fat1;
End;
End;
Procedure nCp(n,p: byte); //Combinations
Var
i: byte;
nCp: real;
Begin
If n < 1 Then
n:=0
Else
n:=(n-1);
For i:=0 to n do
Begin
writeln;
For p:=0 to i do
Begin
nCp:= fat(i) / (fat(p) * fat(i - p)); // mathematic formula for the combinations
Write(nCp:1:0,' ');
End;
End;
End;
{ Main Programa }
Begin
Write('Insert a line(1 -> n) : ');
Readln(linha);
nCp(linha,ordem);
readln;
End.
Just add appropriate number of empty spaces before strings. Note that I used double-spaces, and changed placeholder size to 4 (3+1) to make better formatting.
For p := 1 to (n - i) do
Write(' ');
For p:=0 to i do
Begin
nCp:= fat(i) / (fat(p) * fat(i - p)); // mathematic formula for the combinations
Write(nCp:3:0,' ');
End;
P.S. There are more effective ways to calculate Ncr in reasonable range without real numbers.

How do I use the modulo function with this library?

I am Using this library for Big Integers in Pascal but I am having trouble using the modulo function. Can anyone help?
My code:
a = b modulo(c);
here is the library location: http://www.delphiforfun.org/programs/library/big_integers.htm
{ ***************** Modulo ************* }
procedure TInteger.Modulo(const I2: TInteger);
{ Modulo (remainder after division) - by TInteger }
var
k: int64;
imod3: TInteger;
begin
if high(I2.fDigits) = 0 then begin
divmodsmall(I2.Sign * I2.fDigits[0], k);
assignsmall(k);
end
else
begin
imod3:= GetNextScratchPad;
DivideRem(I2, imod3);
Assign(imod3);
ReleaseScratchPad(imod3);
end;
end;
Why does this not work?:
also why doesnt this work?:
var
P, Q, N, E, D,i: TInteger;
Eing, Cout: TInteger;
begin
E := 3;
D := 27;
N := 55;
writeln(N.Modulo(E));
The source code that you downloaded comes with an example of how to use the modulo function. I urge you to take time to read the example code that comes with a library. If you would do so then you'd be able to solve far more problems by yourself. The example code looks like this:
procedure Tbigints.ModBtnClick(Sender: TObject);
var
i1,i2,i3:Tinteger;
begin
i1:=TInteger.create(0);
i2:=TInteger.create(0);
Getxy(i1,i2);
i1.modulo(i2);
memo1.text:=i1.converttoDecimalString(true);
i1.free;
i2.free;
alloclbl.caption:=format('Allocated memory: %d',[allocmemsize]);
end;
The key point is that the modulo method acts in place. In the code above, the dividend is held in i1 and the divisor in i2. Then you call modulo on i1 passing i2 as the argument. The result of the operation is then placed in i1. So, this method replaces the dividend with the modulus of the division.

Compare to Stringlist

I must compare 2 stringlist , I wonder if the search the first stringlist inside the second stringlist is the only or the recommended version to execute this problem
My code would go like this
var
aFirstStrList: TStringList ;
aSecondStringList: TStringList;
MissingElement_firstElement_not_inside_second: TStringList;
MissingElement_SecondElement_not_inside_First: TStringList;
...
for i := 0 to aFirstStrList.Count - 1 do
begin
if aSecondStringList.IndexOf(aFirstStrList[i] < 0 ) then
begin
// react on not found elements
....
MissingElement_firstElement_not_inside_second.add(...);
end;
end;
// and now same code just opposite search direction ....
....
Instead of using IndexOf, sort both lists before, to prevent searching the whole list at every cycle. Furthermore, it is possible to achieve this in one single loop.
Assuming you want the results in two separate string lists, try the following:
procedure CompareStringLists(List1, List2: TStringList;
Missing1, Missing2: TStrings);
var
I: Integer;
J: Integer;
begin
List1.Sort;
List2.Sort;
I := 0;
J := 0;
while (I < List1.Count) and (J < List2.Count) do
begin
if List1[I] < List2[J] then
begin
Missing2.Add(List1[I]);
Inc(I);
end
else if List1[I] > List2[J] then
begin
Missing1.Add(List2[J]);
Inc(J);
end
else
begin
Inc(I);
Inc(J);
end;
end;
for I := I to List1.Count - 1 do
Missing2.Add(List1[I]);
for J := J to List2.Count - 1 do
Missing1.Add(List2[J]);
end;
Usage:
procedure TForm1.Button1Click(Sender: TObject);
var
List1: TStringList;
List2: TStringList;
begin
List1 := TStringList.Create;
List2 := TStringList.Create;
try
List1.CommaText := 'A, C, F, G, H, K, L, M, N, O, Q, R';
List2.CommaText := 'C, D, E, F, J, P, Q, S, T, U, V, W';
Memo1.Lines.Assign(List1);
Memo2.Lines.Assign(List2);
CompareStringLists(List1, List2, Memo3.Lines, Memo4.Lines);
finally
List2.Free;
List1.Free;
end;
end;
The best performance:
Sort input string lists
Compare with algorithm similar to merge sorted lists(there you will find what is missing in each list)
Simpler but slower:
Copy stringlists to result stringlists
One loop for first string list (use reversed loop for this for Count-1 downto 0 do)
Search same string in second, if found - delete from both lists
Differences will remain in string lists
You have to be careful with that implementation of CompareStringLists. By default the Sort routine of TStringList will sort case insensative but the Comparison used is case-sensative, the up shot being if you have any mixed case in your lists you will get a blowout of the supposed miss-matches.
Either need to set the sorts to be case-sensative by
List1.CaseSensative := true ;
List1.Sort ;
List2.CaseSensative := true ;
List2.Sort ;
OR
Make the comparisons case-insensative
if UpperCase(List1[I]) < UpperCase(List2[J]) then
and
else if UpperCase(List1[I]) > UpperCase(List2[J]) then
respectively.

List Intersection

I want to compute a list "intersection". The problem is:
L1 = [1, 0, 2, 3, 1 , 3, 0, 5]
L2 = [3, 5]
Then the result will be
L3 = [0, 0, 0, 1, 0, 1, 0, 1]
Then i will convert this result in a byte. In this case will be 21 in decimal format.
I want to make in delphi and I need this do efficiently. Is there a way to solve this problem better than O(m*n)?
Here's a function that should do what you want. I defined L2 as a set instead of an array since you said all your values will fit in a Byte. Its complexity is O(n); checking set membership runs in constant time. But since the result needs to fit in a byte, the length of L1 must be bound at 8, so the complexity of this function is actually O(1).
function ArrayMembersInSet(const L1: array of Byte; const L2: set of Byte): Byte;
var
i: Integer;
b: Byte;
begin
Assert(Length(L1) <= 8,
'List is to long to fit in result');
Result := 0;
for i := 0 to High(L1) do begin
b := L1[i];
if b in L2 then
Result := Result or (1 shl (7 - i));
end;
end;
Rob's answer will work for this specific case. For a more general case where two lists have to be compared, you can do it in O(m+n) time if both lists are sorted. (Or O(n log n) time if you have to sort them first, but that's still a lot faster than O(m*n).)
The basic List Comparison algorithm looks like this:
procedure ListCompare(list1, list2: TWhateverList; [Add extra params here]);
var
i, j: integer;
begin
i := 0;
j := 0;
while (i < list1.Count) and (j < list2.Count) do
begin
if list1[i] < list2[j] then
begin
//handle this appropriately
inc(i);
end
else if list1[i] > list2[j] then
begin
//handle this appropriately
inc(j);
end
else //both elements are equal
begin
//handle this appropriately
inc(i);
inc(j);
end;
end;
//optional cleanup, if needed:
while (i < list1.Count) do
begin
//handle this appropriately
inc(i);
end;
while (j < list2.Count) do
begin
//handle this appropriately
inc(j);
end;
end;
This can be customized for a whole bunch of tasks, including list intersection, by changing the "handle this appropriately" places, and it's guaranteed to not run for more steps than are in both lists put together. For list intersection, have the equals case add the value to some output and the other two do nothing but advance the counters, and you can leave off the optional cleanup.
One way to use this algorithm is to make the extra params at the top into function pointers and pass in routines that will handle the appropriate cases, or nil to do nothing. (Just make sure you check for nil before invoking them if you go that route!) That way you only have to write the basic code once.
Well no matter what you will need to visit each element in each list comparing the values. A nested loop would accomplish this in O(n^2) and the conversion should just be local work.
EDIT: I noticed that you want a better runtime than O(n*m).

Resources