Sets of all disjoint pairs - c

Given a set {1,2,3,4,5...n} of n elements, we need to find all sets of disjoint pairs.
For example, if n=4, the output would be
{(1,2),(3,4)}, {(1,3),(2,4)}, {(1,4),(2,3)}
I am not even able to figure out how to start. I am hoping someone can give me a suggestion about which algorithm to use, and possibly some implementation details as well.

Edit:
Delphi code for recursive generation of (n-1)!! sets (1*3*5*7...n-1) from n=2*k elements
var
A: TArray<Integer>;
procedure Swap(i, j: integer);
var
t : integer;
begin
t := A[i];
A[i] := A[j];
A[j] := t;
end;
procedure MakePairs(Start: Integer; Pairs: string);
var
i: Integer;
begin
if Start >= Length(A) then
Writeln(Pairs)
else
for i := Start + 1 to High(A) do begin
Swap(Start + 1, i); //store used element in the array beginning
MakePairs(Start + 2, Pairs + Format('(%d,%d)', [A[Start], A[Start + 1]]));
Swap(Start + 1, i); //get it back
end;
end;
begin
A := TArray<Integer>.Create(1,2,3,4,5,6);
//be sure that array length is even!!!
MakePairs(0, '');
Writeln(PairCount);
Output:
(1,2)(3,4)(5,6)
(1,2)(3,5)(4,6)
(1,2)(3,6)(5,4)
(1,3)(2,4)(5,6)
(1,3)(2,5)(4,6)
(1,3)(2,6)(5,4)
(1,4)(3,2)(5,6)
(1,4)(3,5)(2,6)
(1,4)(3,6)(5,2)
(1,5)(3,4)(2,6)
(1,5)(3,2)(4,6)
(1,5)(3,6)(2,4)
(1,6)(3,4)(5,2)
(1,6)(3,5)(4,2)
(1,6)(3,2)(5,4)
15
Addition
Variant that works with odd-length array too (weird ordering)
procedure MakePairs(Start: Integer; Pairs: string);
var
i: Integer;
OddFlag: Integer;
begin
if Start >= Length(A) then
Memo1.Lines.Add(Pairs)
else begin
Oddflag := (High(A) - Start) and 1;
for i := Start + OddFlag to High(A) do begin
Swap(Start + OddFlag, i);
if OddFlag = 1 then
MakePairs(Start + 2, Pairs + Format('(%d,%d)', [A[Start], A[Start + 1]]))
else
MakePairs(Start + 1, Pairs);
Swap(Start + OddFlag, i);
end;
end;
end;
for (1,2,3,4,5):
(2,3)(4,5)
(2,4)(3,5)
(2,5)(4,3)
(1,3)(4,5)
(1,4)(3,5)
(1,5)(4,3)
(2,1)(4,5)
(2,4)(1,5)
(2,5)(4,1)
(2,3)(1,5)
(2,1)(3,5)
(2,5)(1,3)
(2,3)(4,1)
(2,4)(3,1)
(2,1)(4,3)
15
Not relevant now:
If every pair should occur just once (it is not clear from your example with n=4), then you can use round-robin tournament algorithm
n=4 case example here

You have to see the pattern here.
For {1, 2, 3, 4}.
Take the first element and make pairs with all the elements on the right.
(1, 2), (1, 3), (1, 4)
Take the second element and make pairs with all the elements on the right.
(2, 3), (2, 4)
Take the third element and make pairs with all the elements on the right.
(3, 4)
...and so on
Notice the pattern here.
You would need an outer loop to iterate over the elements and select each element one by one.
And another inner loop to iterate over the elements on the right of the selected element and make a pair with each one of them.

Related

Hi, I keep getting an access violation while setting the length of my dynamic arrays

procedure TfrmMain.createpnl(i: integer);
var
j,c: integer;
begin
c:=5;
top := pnlResult1.top;
for j := 1 TO i do
if (arrFound[j] <> -1) or (arrFound[j] <> 0) then
begin
with dmAll do
begin
tblHouses.First;
while not tblHouses.Eof do
begin
if tblHouses['ID'] = arrFound[j] then
begin
if j > 1 then
itop := j * pnlResult1.top + (j - 1) * pnlResult1.Height;
SetLength(arrpnl, c);
SetLength(arrimg, c);
SetLength(arrlbl[1], c);
SetLength(arrlbl[2], c);
SetLength(arrlbl[3], c);
SetLength(arrlbl[4], c);
SetLength(arrlbl[5], c);
SetLength(arrlbl[6], c);
{ the violation usually happes at arrlbl[6] but it has been in the neighboring area before }
/// ///////////dupe panels
arrpnl[c] := TPanel.Create(frmMain);
with arrpnl[c] do
begin
Parent := scbMain;
Width := pnlResult1.Width;
Height := pnlResult1.Height;
left := pnlResult1.left;
top := itop;
Visible := true;
Color := pnlResult1.Color;
end;
frmMain.Position:=poScreenCenter;
/// //////////dupe photos
arrimg[c] := TImage.Create(frmMain);
with arrimg[c] do
begin
Parent := arrpnl[c];
Width := Image1.Width;
Height := Image1.Height;
left := Image1.left;
top := Image1.top;
end;
{ i cut some spaghetti code to shorten question }
tblPhotos.First;
while NOT tblPhotos.Eof do
begin
if tblPhotos['HouseID'] = tblHouses['ID'] then
if fileexists(tblPhotos['photo']) then
begin
arrimg[c].Picture.LoadFromFile(tblPhotos['photo']);
arrimg[c].Stretch := true;
end
else
begin
if fileexists('H:\v0.1\not-found-image-15383864787lu.jpg') then
begin
arrimg[c].Picture.LoadFromFile
('H:\v0.1\not-found-image-15383864787lu.jpg');
arrimg[c].Stretch := true;
end;
end;
tblPhotos.Next
end;
tblOwners.First;
while NOT tblOwners.Eof do
begin
if tblOwners['ID'] = tblHouses['hOwner'] then
begin
arrlbl[4][c].caption := 'Email: ' + tblOwners['oEmail'] + #10 +
'Cell number: ' + tblOwners['oCell'];
end;
tblOwners.Next;
end;
inc(c);
bFound := true;
end;
tblHouses.Next;
end;
end;
end;
end;
I search through a database to find guesthouses that match the search criteria in an above procedure.
The search returns an array (arrFound) filled with ID's of houses that match search criteria.
I then make all duplicate results -1 and create TPanels dynamically to return the guesthouses as browseable results in a TScrollBox.
The dynamic array in question (arrlbl) is a 2D array of TLabels with a predetermined first value and a dynamic second value (depending on the amount of results).
I used 1D arrays but that gave the same error and I have a similar procedure on another form that doesn't give any errors.
It seems like you got the indices wrong.
In general, a dynamic array with n elements has indices 0..n - 1.
For example, if a is a dynamic array with 5 elements, the elements are a[0], a[1], a[2], a[3], and a[4]. There is no a[5].

Pascal arranging array, with a row number

type
mas = array [1 .. 10000] of real;
var
n: integer;
a: mas;
Rf: text;
Procedure Skaityti;
var
i: integer;
Df: text;
begin
Assign(Df, 'duom1.txt');
Reset(Df);
Readln(Df, n);
for i := 1 to n do
Read(Df, a[i]);
Close(Df);
end;
Procedure MinMax(var min, max, nrmin, nrmax, vid: real);
var
i: integer;
begin
min := a[1];
max := a[1];
nrmin := 1;
nrmax := 1;
for i := 1 to n do
begin
if min > a[i] then
begin
min := a[i];
nrmin := i;
end;
if max < a[i] then
begin
max := a[i];
nrmax := i;
end;
vid := vid + a[i];
end;
vid := vid / n;
end;
var
min, max, nrmin, nrmax, vid: real;
begin
Skaityti;
MinMax(min, max, nrmin, nrmax, vid);
Assign(Rf, 'rez.txt');
Rewrite(Rf);
WriteLn(Rf, 'biggest amount ', max:7:2, ' number ', nrmax:7:0);
WriteLn(Rf, 'smallest amount ', min:7:2, ' number', nrmin:7:0);
WriteLn(Rf, 'average amount ', vid:7:2);
WriteLn(Rf);
WriteLn(Rf, 'number amount');
Close(Rf);
end.
This is the code and it Reads elements from a .txt file to an array, I created procedure to find biggest and smallest value of it. Now I need to create a procedure to write my array from biggest to smallest and a row number next to it. It should look something like this:
Row number value
5 1000000
6 999999
8 888888
and so on.. Any ideas ?
P.S. I can arrange that array to be from biggest to smallest but then the row numbers will mess up :/
Create a record type with two fields, one for the value from the file and the other for the "row" number.
Change the array to be an array of that record type.
When reading the file in the for loop, assign the read value to the value field of the record and the for loop control variable value as the "row" number.
When you sort the array, you sort the records, thus keeping value and row together.

Remove duplicate array elements

I need to remove all duplicate values from an array of integer, yet maintain the order of the elements:
Example:
10,20,20(duplicate),10(duplicate),50
Becomes:
10,20,50
Create a dictionary with Integer as the key. The value type is immaterial.
Iterate through the input array. For each value in the input array, check whether or not that value is in the dictionary.
If yes, this is a duplicate, discard.
If no, this is the first time the value has been encountered. Retain the value, and add it to the dictionary.
The point of the dictionary is that it can perform O(1) lookup.
In pseudocode:
var
arr: TArray<Integer>; // input and output
Dict: TDictionary<Integer, Integer>;
SrcIndex, DestIndex: Integer;
....
DestIndex := 0;
for SrcIndex := 0 to high(arr) do begin
Value := arr[SrcIndex];
if not Dict.ContainsKey(Value) then begin
arr[DestIndex] := arr[SrcIndex];
Dict.Add(Value, 0);
inc(DestIndex);
end;
end;
SetLength(arr, DestIndex);
Obviously you need to create, and destroy, the dictionary. I'm assuming you know how to do that. And I've opted to modify the array in place but you could equally create a new array if you prefer.
heres a version without dictionary.
procedure TForm1.RemoveDuplicates;
var
i,j,k,tot,mov:integer;
arr:array of integer;
begin
arr := [10,20,30,40,30,20,10,10,50,10,20,40];
tot := 0;
for i := 0 to length(arr)-1 do
begin
if i >= length(arr)-tot-1 then
break;
for j := i + 1 to length(arr)-1-tot do
begin
if j >= length(arr)-tot-1 then
break;
mov := 0;
while arr[i] = arr[j] do
begin
inc(mov);
arr[j] := arr[j+mov];
end;
tot := tot + mov;
if mov>0 then
for k := j+1 to length(arr)-1-tot do
arr[k] := arr[k+mov];
end;
end;
SetLength(arr,length(arr)-tot-1);
end;

Delphi - EAcessViolation Error

So guys... I've read aroung A LOT and I've tried using addons like madExcept (which I'm new to) but I've so far been unable to determine whats causing my errors.
I'm getting EAccessViolation Exceptions on my code when calling SetLength() at seemingly random times. I have been unable to determine the reason behind it and I can't even track it down to a single line of code. I'd like you to please help me sort it out.
This function is supposed to look for repeated patterns in a number array and count them.
Currently, its logic is still not 100% ready, but I want to correct these bugs before I proceed.
An example of how it will work when done:
Given the array {1, 2, 3, 4, 1, 2, 3, 5}, the function it will compare the subarray (1, 2, 3) to all other possible subarrays like (4, 1, 2), (1, 2, 3) and (2, 3, 5), counting the cases when they are the same. The function will then proceed to the next length and begin once again by comparing (1, 2, 3, 4) to (1, 2, 3, 5)...
The maximum array lenght is 45.
The minimum subarray length is 3.
The EAccessViolation error usually happens at array length 12-13 and usually at the last iteration of the first loop.
Once again, I know there are flaws on the algorithm logic itself, but I really wanna fix the memory stuff first.
Thank you very much.
function TfrmMain.Ready(Numbers: Array of SmallInt): SmallInt;
var
i: Integer;
Length, MinLength, MaxLength: SmallInt;
Array1, Array2: Array of SmallInt;
Array1Pos, Array1FirstPos, Array1LastPos: Integer;
Array2Pos, Array2FirstPos, Array2LastPos: Integer;
begin
Result := 0;
MinLength := 3;
MaxLength := Trunc( (High(Numbers) + 1 ) / 2 );
for Length := MinLength to MaxLength do
begin
SetLength(Array1, 0);
SetLength(Array2, 0);
SetLength(Array1, Length);
Array1FirstPos := 0;
Array1LastPos := High(Numbers) - High(Array1);
for Array1Pos := Array1FirstPos to Array1LastPos do
begin
for i := Array1Pos to Length + Array1Pos do
Array1[i - Array1Pos] := Numbers[i];
if ( High(Array2) + 1 <> Length ) then
SetLength(Array2, Length);
Array2FirstPos := Array1Pos + Length;
Array2LastPos := High(Numbers);
if ( ( Array1Pos >= Array2FirstPos ) and ( Array1Pos + Length <= Array2LastPos ) ) then
for Array2Pos := Array2FirstPos to Array2LastPos do
begin
for i := Array2Pos to Length + Array2Pos do
Array2[i - Array2Pos] := Numbers[i];
if CompareArrays(Array1, Array2) then
Result := Result + 1;
end;
end;
end;
SetLength(Array1, 0);
SetLength(Array2, 0);
end;
function TfrmMain.CompareArrays(Array1, Array2: Array of SmallInt): Boolean;
var
i: Integer;
begin
Result := false;
if ( High(Array1) <> High(Array2) ) then
Exit;
for i := 0 to High(Array1) do
if ( Array1[i] <> Array2[i] ) then
Exit;
Result := true;
end;
SOLVED! Thanks Jeferson Oliveira!
The error raising depends on the content of the arrays your are passing, so would be better if you could show us a calling example, or the content of your Memo.
Anyway, analyzing your code, I can see some things:
In the line below:
if ( High(Array2) + 1 <> Length ) then
SetLength(Array2, Length);
If Length = 0, or Length = High(Array2) + 1, the Array2 Length will not be defined.
Thus, when the code below is executed:
if ( ( Array1Pos >= Array2FirstPos ) and ( Array1Pos + Length <= Array2LastPos ) ) then
for Array2Pos := Array2FirstPos to Array2LastPos do
begin
for i := Array2Pos to Length + Array2Pos do
Array2[i - Array2Pos] := Numbers[i];
If the length of Array2 is not yet defined, you could have and AccessViolation.
So (for the only purpose of fix this code), you should test the length of Array2 before try to access its index, with:
for i := Array2Pos to Length + Array2Pos do
begin
if ((i - Array2Pos) >= System.Length(Array2) - 1) then
Array2[i - Array2Pos] := Numbers[i];
end;
But I believe that focusing on your logic and organizing some test values you will see that are a lot of improvement to be done to your code that will, themselves, solve the current AV.
Edited: as your variable has the same name of the global function "Length", I updated the sample code to use the "namespace" System.

How to find the smallest and biggest number in an array?

Hello how can I find the smallest and biggest number in delphi?
Suppose I have 10 different numbers stored in an array:
How can I find the biggest number and smallest numbers in my array?
Simply loop through the array in linear fashion. Keep a variable for the min value and one for the max values. Initialise both to the first value in the array. Then for each element, update the min or max value if that element is less than or greater than the min or max value respectively.
minval := a[0];
maxval := a[0];
for i := 1 to Count-1 do
begin
if a[i]<minval then
minval := a[i]
else if a[i]>maxval then
maxval := a[i];
end;
Obviously this code assumes Count>0.
Note that you could equally use the MinValue and MaxValue routines from the Math unit.
Iterate through the array comparing to the previous found min and max.
Here is a code snippet. Following your clarification, I have edited the code to use Int64.
Min := High(Int64);
Max := Low(Int64);
for ThisNumber in MyArray do
begin
if ThisNumber < Min then
begin
Min := ThisNumber;
end
if ThisNumber > Max then
begin
Max := ThisNumber;
end;
end;
It's interesting to note that MaxIntValue in Math.pas is implemented as:
function MaxIntValue(const Data: array of Integer): Integer;
var
I: Integer;
begin
Result := Data[Low(Data)];
for I := Low(Data) + 1 to High(Data) do
if Result < Data[I] then
Result := Data[I];
end;
This implementation, similar to David's answer, uses the first array value as the initial value. This assumes that the array has at least one element. Note also that the loop can then start at Low(Data) + 1 and save one unnecessary comparison. For the data you have described, with 100 elements in each array, you would get a 1% speed improvement, at best.
If performance doesn't matter then MinIntValue and MaxIntValue will be more concise. If you roll your own, then you are only iterating through the array once instead of twice.
Create a function that takes an array of numbers and return both the minimum and maximum numbers, in that order.
// Examples
// minMax([1, 2, 3, 4, 5]) ➞ [1, 5]
// minMax([2334454, 5]) ➞ [5, 2334454]
// minMax([1]) ➞ [1, 1]
const minMax = (arr) => {
let newMinMax = [];
let min = Math.min(...arr);
newMinMax.push(min);
let max = Math.max(...arr);
newMinMax.push(max);
return newMinMax;
};
// console.log(minMax([1, 2, 3, 4, 5]));
// console.log(minMax([2334454, 5]));
// console.log(minMax([1]));
Used javascript build in functions for that .Math.min function requires distinct number but when we provide array it will give you a NaN to avoid that use [...arr]
spread operator of Math.min.apply(Math,arr) function.

Resources