I've a function that checks if there is a repeat data in the array; That looks like shown below. The task is using that function find the columns in matrix with no repeating data. The question is to how to pass the column of the matrix to that function.
P.S. I'm using Pascal/Delphi
type
myArray = array [1..10] of integer;
function noRepeat(A: myArray; n: integer): Boolean;
var
i: integer;
begin
Result := true;
for i:=1 to n do
for j := i + 1 to n do
if (A[i] = A[j]) then
Result := true;
end;
In the example below:
matrix[column][row]
is how the 'myMatrix' type is structured. Just iterate through the first array and send it off to your testing function.
Also, in the testing function, make sure you set your result to false to begin with!
type
myArray = array [1..10] of integer;
myMatrix = array[1..10] of myArray;
var
matrix: myMatrix;
function noRepeat(const A: myArray): Boolean;
var
i: integer;
begin
//Result := true; //?
Result := false;
for i:=1 to high(A) do
for j := i + 1 to high(A) do
if (A[i] = A[j]) then
Result := true;
end;
procedure sendColumn;
var
b, wasRepeat: boolean;
i: Integer;
Begin
for i := low(matrix) to high(matrix) do
Begin
b := noRepeat(matrix[i]);
if b then
wasRepeat := true;
End;
End;
if it's row major, then you'll have to inform the testing routine of which column you want to test.
type
myArray = array [1..10] of integer;
myMatrix = array[1..10] of myArray;
var
matrix: myMatrix;
function noRepeat(const A: myMatrix; Col: Integer): Boolean;
var
i, j: integer;
begin
Result := false;
for i := low(A) to high(A) do
for j := i + low(A) to high(A) do
if (A[i][Col] = A[j][Col]) then
Result := true;
end;
procedure sendColumn;
var
b, wasRepeat: boolean;
i: Integer;
Begin
for i := 1 to 10 do
Begin
b := noRepeat(matrix, i);
if b then
wasRepeat := true;
End;
End;
Related
This program is supposed to sort an array and fill it with random integers from 1 to 1000. It needs to find the maximum value and print the array. It should print the array in two ways: ARRAY OF INTEGER and ArrayType. I need help to print this array in ArrayType. I am not super familiar with Pascal and my assignment is to print this array with ArrayType as a parameter. This is my code I have so far:
PROGRAM SortingAlgorithm;
Var intArray : array[1..20] OF INTEGER;
Var i, j, index : INTEGER;
PROCEDURE Sort(intArray : ARRAY OF INTEGER; size : INTEGER);
BEGIN
FOR i := 2 to 20 do
BEGIN
index := intArray[i];
j := i;
WHILE ((j > 1) AND (intArray[j-1] > index)) do
BEGIN
intArray[j] :=intArray[j-1];
j := j - 1;
END;
intArray[j] := index;
END;
END;
PROCEDURE fillArray(var a,b : integer);
VAR temp : INTEGER;
BEGIN
temp := a;
a := b;
b := temp;
END;
BEGIN
FOR i := 1 to 20 do
intArray[i] := i;
FOR i := 1 to 20 do
fillArray(intArray[i],intArray[random(20)+1]);
END.
PROCEDURE findMax(intArray : ARRAY OF INTEGER; size : INTEGER);
VAR max : INTEGER;
begin
max := 1;
FOR i := 2 to size do
BEGIN
IF intArray[i] > intArray[max] THEN
max:=i;
END;
END;
PROCEDURE printArray(intArray : ARRAY OF INTEGER; size : INTEGER);
BEGIN
FOR i := 1 to 20 do
Writeln(intArray[i]);
END;
PROCEDURE printArray2();
BEGIN
END;
BEGIN
fillArray (intArray);
printArray (intArray);
printArray2 (intArray);
largestValue := findMax (intArray);
WriteLn (‘The largest value is ‘, largestValue);
sort (intArray);
printArray (intArray);
END.
printArray2 is for the ArrayType parameter. This is all the information I was given for this program, I'm not sure what printing with a parameter of ArrayType means. Any help is appreciated. Thanks.
program R3cord;
type rekord = record
end;
var i,d,j,c,x,y,a : integer;
mas : array[1..5] of rekord;
begin
x := 4;
y := 5;
for i := 1 to y do
Read(mas[i]);
for i := 1 to x do
begin
d := i;
for j := i + 1 to y do
if mas[j] > mas[d] then
d := j;
c := mas[i]; mas[i] := mas[d]; mas[d] := c;
end;
for i := 1 to 5 do
Write(mas[i],' ');
end.
I'm having a trouble here, as you can see this program will read user's input and will sort it in descending order. I need to have a row number near number which was before the sorting. I've read that record is good for it, but I can't find any tutorials how to do it.
First, your record doesn't have anything in it. I think you want:
type
rekord = record
value: Integer;
row: Integer;
end;
And when you read it in:
for i := 1 to 5 do
begin
Read(mas[i].value);
mas[i].row = i;
end
The above will number the rows 1, 2, 3, ...
And in your sort:
if mas[j].value > mas[d].value
When you swap, be sure to swap the whole record as you're currently doing. Don't just swap the values.
I have multiple arrays and they all start with integer fields, from 1 up to 5 fields, and these are like indexes that need to be sorted, from min to max:
TArrayA = record
Field1:integer;
Field2:integer;
Field3:integer;
Field4:integer;
Field5:integer;
... //other fields, strings, integers... up to 50 fields
end;
ArrayA:=array of TArrrayA;
Currently I use this approach to sort:
// sort by Field1
top:=Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if ArrayA[look].Field1 < ArrayA[min].Field1 then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// now sort by Field2
top:=Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) And
(ArrayA[look].Field2 < ArrayA[min].Field2) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
This does the job. Although is a bit slow when I need to sort all 5 fields,
and this is how I do it, field by field, so I sort the array 5 times. Is there any better, faster way?
Here is example:
procedure TForm1.Button8Click(Sender: TObject);
type
TArrayA = record
Field1: integer;
Field2: integer;
Field3: integer;
Field4: integer;
Field5: integer;
end;
var
ArrayA: array of TArrayA;
vTmpRecord: TArrayA;
top, counter, min, max, look: integer;
i,t1,t2:integer;
begin
SetLength(ArrayA,100000);
for i := 0 to 99999 do
begin
ArrayA[i].Field1:=1+Random(100);
ArrayA[i].Field2:=1+Random(100);
ArrayA[i].Field3:=1+Random(100);
ArrayA[i].Field4:=1+Random(100);
ArrayA[i].Field5:=1+Random(100);
end;
t1:=GetTickCount;
// sort by Field1
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if ArrayA[look].Field1 < ArrayA[min].Field1 then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field2
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and
(ArrayA[look].Field2 < ArrayA[min].Field2) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field3
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and (ArrayA[look].Field2 = ArrayA[min].Field2) and
(ArrayA[look].Field3 < ArrayA[min].Field3) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field4
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and (ArrayA[look].Field2 = ArrayA[min].Field2) and (ArrayA[look].Field3 = ArrayA[min].Field3) and
(ArrayA[look].Field4 < ArrayA[min].Field4) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
// sort by Field5
top := Length(ArrayA);
for counter := 0 to top do
begin
min := counter;
for look := counter + 1 to top do
if (ArrayA[look].Field1 = ArrayA[min].Field1) and (ArrayA[look].Field2 = ArrayA[min].Field2) and (ArrayA[look].Field3 = ArrayA[min].Field3) and (ArrayA[look].Field4 = ArrayA[min].Field4) and
(ArrayA[look].Field5 < ArrayA[min].Field5) then
min := look;
vTmpRecord := ArrayA[min];
ArrayA[min] := ArrayA[counter];
ArrayA[counter] := vTmpRecord;
end;
t2:=GetTickCount;
Button8.Caption:=IntToStr(t2-t1);
end;
You can use built in Quick sort method for sorting arrays with your custom comparer:
uses
System.Math,
System.Generics.Defaults,
System.Generics.Collections;
TArray.Sort<TArrayA>(ArrayA, TComparer<TArrayA>.Construct( function(const Left, Right: TArrayA): Integer
begin
if Left.Field1 = Right.Field1 then
begin
if Left.Field2 = Right.Field2 then
begin
Result := CompareValue(Left.Field3, Right.Field3);
end
else Result := CompareValue(Left.Field2, Right.Field2);
end
else Result := CompareValue(Left.Field1, Right.Field1);
end
));
I added code only for first three fields, but you will get the picture how to build your own comparer for more fields.
The most important thing for you to do is to separate the sort algorithm from the data. That way you can write, or use, a single sort algorithm again and again with different data
The classic way to do that is to use a comparison sort. They are sort algorithms that require a compare function that compares two items and returns a negative integer for less than, a positive integer for greater than, and zero when equal.
So, let's start by demonstrating such a compare function for your data. Storing multiple fields as you have makes it hard to write a general purpose comparer. Better to put the fields in an array. Once you have done so you can do the compare lexicographically using iteration like this:
function CompareIntegerArray(const lhs, rhs: array of Integer): Integer;
var
i: Integer;
begin
Assert(Length(lhs) = Length(rhs));
for i := low(lhs) to high(lhs) do
if lhs[i] < rhs[i] then
exit(-1)
else if lhs[i] > rhs[i] then
exit(1);
exit(0);
end;
With a lexicographic order we first compare the primary field. If they differ we have our answer, otherwise we move on to the secondary field. And so on. Such an algorithm is well suited to iteration as demonstrated above.
This overcomes a significant weakness in your approach, by sorting the array once only.
Once you have this compare function you need to wrap it in an outer compare function that extracts data from the record fields and populates arrays. Perhaps along these lines:
type
TMyArray = array [1..5] of Integer;
function GetMyArray(const Value: TArrayA): TMyArray;
begin
Result[1] := Value.Field1;
Result[2] := Value.Field2;
....
end;
function MyCompare(const lhs, rhs: TArrayA): Integer;
begin
Result := CompareIntegerArray(
GetMyArray(lhs),
GetMyArray(rhs)
);
end;
Now, as promised, you can use this compare function with a general purpose sort like TArray.Sort<T> from Generics.Collections. This is an implementation of Quicksort, a comparison sort with average complexity of O(n log n). That will typically yield a huge benefit over your O(n2) bubble sort.
Life would be simpler if you could replace the record with an actual array. Another option that might be useful would be to add a method to the record that returned an array of integer ready for use in the lexicographic compare function.
To recap:
Separate data, comparison and sorting to facilitate re-use and clarity.
Use arrays to enable lexicographic compare to be implemented with a loop.
Use an efficient sort algorithm such as Quicksort.
To find the intersection of N arrays I have this implementation, which is horribly inefficient. I know there has to be an algorithm out there to speed this up.
note: myarray is the array containing all my other arrays for which I want to find the intersection for.
var
i, j, k: integer;
myarray: Array of Array of integer;
intersection: array of integer;
for I := 0 to length(myarray)-1 do
begin
for J := 0 to length(myarray)-1 do
begin
if i = j then
continue;
for k := 0 to length(myarray[i])-1 do
begin
if myarray[i][j] = myarray[j][k] then
begin
setLength(intersection, length(intersection)+1);
intersection[length(intersection)-1] := myarray[j][k];
end;
end;
end;
end;
What optimization can I apply to speed this up? Is there a faster way of doing this?
EDIT: Data in arrays are unsorted.
There is a faster way: the list comparison algorithm. It allows you to compare two lists in linear time instead of quadratic time. Here's the basic idea:
Sort both lists by the same criteria. (Make copies of the lists first, if you need to preserve the original ordering.)
Start at the top of both lists. Pick the first item from each and compare them.
If they match, handle the case and advance the index for both lists.
If they don’t match, loop through, advancing the index for the list with the “lesser” value each time, until a match is found.
When you reach the end of either list, you’re done. (Unless you want to handle any leftovers from the other list.)
This can be extended to deal with more than 2 lists with a bit of effort.
Unfortunately, you have not updated your question yet, so it still is not exactly clear what you are asking. E.g. you talk about an intersection (which should search for values that exist in every single array), but from the (not working) code it seems you are simply searching for duplicates in any of the arrays.
Although Mason's answer points to an obvious general solution for these kind of algorithms, I believe it is somewhat different for such a multi-dimensional array. I worked out two routines for determination of (1) the intersection as well as (2) the duplicates. Both assume unordered content of unequal length in the arrays.
First, I decided to introduce some new types:
type
PChain = ^TChain;
TChain = array of Integer;
TChains = array of TChain;
Secondly, both routines need some sorting mechanism. A very quick but dirty one is done by employing/misusing a TList:
function CompareInteger(Item1, Item2: Pointer): Integer;
begin
Result := Integer(Item1) - Integer(Item2);
end;
procedure SortChain(var Chain: TChain);
var
List: TList;
begin
List := TList.Create;
try
List.Count := Length(Chain);
Move(Chain[0], List.List[0], List.Count * SizeOf(Integer));
List.Sort(CompareInteger);
Move(List.List[0], Chain[0], List.Count * SizeOf(Integer));
finally
List.Free;
end;
end;
But a much nicer implementation is gotten by adjusting the RTL code from Classes.QuickSort, which does exactly the same as the one above, without copying the array (twice):
procedure SortChain(Chain: PChain; L, R: Integer);
var
I: Integer;
J: Integer;
Value: Integer;
Temp: Integer;
begin
repeat
I := L;
J := R;
Value := Chain^[(L + R) shr 1];
repeat
while Chain^[I] < Value do
Inc(I);
while Chain^[J] > Value do
Dec(J);
if I <= J then
begin
Temp := Chain^[I];
Chain^[I] := Chain^[J];
Chain^[J] := Temp;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
SortChain(Chain, L, J);
L := I;
until I >= R;
end;
Intersection:
To obtain the intersection of all arrays, comparing all values in the shortest array with the values in all other arrays is enough. Because the shortest array may contain duplicate values, that small array is sorted in order to be able to ignore the duplicates. From that point it is simply a matter of finding (or rather nót finding) a same value in one of the other arrays. Sorting all other arrays is not necessary, because the chance to find a value at an earlier position than within a sorted array is 50%.
function GetChainsIntersection(const Chains: TChains): TChain;
var
IShortest: Integer;
I: Integer;
J: Integer;
K: Integer;
Value: Integer;
Found: Boolean;
FindCount: Integer;
begin
// Determine which of the chains is the shortest
IShortest := 0;
for I := 1 to Length(Chains) - 1 do
if Length(Chains[I]) < Length(Chains[IShortest]) then
IShortest := I;
// The length of result will at maximum be the length of the shortest chain
SetLength(Result, Length(Chains[IShortest]));
Value := 0;
FindCount := 0;
// Find for every value in the shortest chain...
SortChain(#Chains[IShortest], 0, Length(Chains[IShortest]) - 1);
for K := 0 to Length(Chains[IShortest]) - 1 do
begin
if (K > 0) and (Chains[IShortest, K] = Value) then
Continue;
Value := Chains[IShortest, K];
Found := False;
for I := 0 to Length(Chains) - 1 do
if I <> IShortest then
begin
Found := False;
for J := 0 to Length(Chains[I]) - 1 do
// ... the same value in other chains
if Chains[I, J] = Value then
begin
Found := True;
Break;
end;
if not Found then
Break;
end;
// Add a found value to the result
if Found then
begin
Result[FindCount] := Value;
Inc(FindCount);
end;
end;
// Truncate the length of result to the actual number of found values
SetLength(Result, FindCount);
end;
Duplicates:
This also does not require sorting all arrays individually. All values are copied into a one-dimensional temporary array. After sorting thát array, it is easy to find the duplicates.
function GetDuplicateShackles(const Chains: TChains): TChain;
var
Count: Integer;
I: Integer;
Temp: TChain;
PrevValue: Integer;
begin
// Foresee no result
SetLength(Result, 0);
// Count the total number of values
Count := 0;
for I := 0 to Length(Chains) - 1 do
Inc(Count, Length(Chains[I]));
if Count > 0 then
begin
// Copy all values to a temporary chain...
SetLength(Temp, Count);
Count := 0;
for I := 0 to Length(Chains) - 1 do
begin
Move(Chains[I][0], Temp[Count], Length(Chains[I]) * SizeOf(Integer));
Inc(Count, Length(Chains[I]));
end;
// Sort the temporary chain
SortChain(#Temp, 0, Count - 1);
// Find all duplicate values in the temporary chain
SetLength(Result, Count);
Count := 0;
PrevValue := Temp[0];
for I := 1 to Length(Temp) - 1 do
begin
if (Temp[I] = PrevValue) and
((Count = 0) or (Temp[I] <> Result[Count - 1])) then
begin
Result[Count] := PrevValue;
Inc(Count);
end;
PrevValue := Temp[I];
end;
SetLength(Result, Count);
end;
end;
Sample application:
And because I like to test all my code, it needed very little work to make it somewhat representative.
unit Unit1;
interface
uses
SysUtils, Classes, Controls, Forms, StdCtrls, Grids;
type
PChain = ^TChain;
TChain = array of Integer;
TChains = array of TChain;
TForm1 = class(TForm)
Grid: TStringGrid;
IntersectionFullButton: TButton;
IntersectionPartialButton: TButton;
DuplicatesFullButton: TButton;
DuplicatesPartialButton: TButton;
Memo: TMemo;
procedure FormCreate(Sender: TObject);
procedure IntersectionButtonClick(Sender: TObject);
procedure DuplicatesButtonClick(Sender: TObject);
private
procedure ClearGrid;
procedure ShowChains(const Chains: TChains);
procedure ShowChain(const Chain: TChain; const Title: String);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
MaxDepth = 20;
procedure FillChains(var Chains: TChains; FillUp: Boolean; MaxValue: Integer);
var
X: Integer;
Y: Integer;
Depth: Integer;
begin
SetLength(Chains, MaxDepth);
for X := 0 to MaxDepth - 1 do
begin
if FillUp then
Depth := MaxDepth
else
Depth := Random(MaxDepth - 2) + 3; // Minimum depth = 3
SetLength(Chains[X], Depth);
for Y := 0 to Depth - 1 do
Chains[X, Y] := Random(MaxValue);
end;
end;
procedure SortChain(Chain: PChain; L, R: Integer);
var
I: Integer;
J: Integer;
Value: Integer;
Temp: Integer;
begin
repeat
I := L;
J := R;
Value := Chain^[(L + R) shr 1];
repeat
while Chain^[I] < Value do
Inc(I);
while Chain^[J] > Value do
Dec(J);
if I <= J then
begin
Temp := Chain^[I];
Chain^[I] := Chain^[J];
Chain^[J] := Temp;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
SortChain(Chain, L, J);
L := I;
until I >= R;
end;
function GetChainsIntersection(const Chains: TChains): TChain;
var
IShortest: Integer;
I: Integer;
J: Integer;
K: Integer;
Value: Integer;
Found: Boolean;
FindCount: Integer;
begin
IShortest := 0;
for I := 1 to Length(Chains) - 1 do
if Length(Chains[I]) < Length(Chains[IShortest]) then
IShortest := I;
SetLength(Result, Length(Chains[IShortest]));
Value := 0;
FindCount := 0;
SortChain(#Chains[IShortest], 0, Length(Chains[IShortest]) - 1);
for K := 0 to Length(Chains[IShortest]) - 1 do
begin
if (K > 0) and (Chains[IShortest, K] = Value) then
Continue;
Value := Chains[IShortest, K];
Found := False;
for I := 0 to Length(Chains) - 1 do
if I <> IShortest then
begin
Found := False;
for J := 0 to Length(Chains[I]) - 1 do
if Chains[I, J] = Value then
begin
Found := True;
Break;
end;
if not Found then
Break;
end;
if Found then
begin
Result[FindCount] := Value;
Inc(FindCount);
end;
end;
SetLength(Result, FindCount);
end;
function GetDuplicateShackles(const Chains: TChains): TChain;
var
Count: Integer;
I: Integer;
Temp: TChain;
PrevValue: Integer;
begin
SetLength(Result, 0);
Count := 0;
for I := 0 to Length(Chains) - 1 do
Inc(Count, Length(Chains[I]));
if Count > 0 then
begin
SetLength(Temp, Count);
Count := 0;
for I := 0 to Length(Chains) - 1 do
begin
Move(Chains[I][0], Temp[Count], Length(Chains[I]) * SizeOf(Integer));
Inc(Count, Length(Chains[I]));
end;
SortChain(#Temp, 0, Count - 1);
SetLength(Result, Count);
Count := 0;
PrevValue := Temp[0];
for I := 1 to Length(Temp) - 1 do
begin
if (Temp[I] = PrevValue) and
((Count = 0) or (Temp[I] <> Result[Count - 1])) then
begin
Result[Count] := PrevValue;
Inc(Count);
end;
PrevValue := Temp[I];
end;
SetLength(Result, Count);
end;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Grid.ColCount := MaxDepth;
Grid.RowCount := MaxDepth;
end;
procedure TForm1.ClearGrid;
var
I: Integer;
begin
for I := 0 to Grid.ColCount - 1 do
Grid.Cols[I].Text := '';
end;
procedure TForm1.ShowChains(const Chains: TChains);
var
I: Integer;
J: Integer;
begin
for I := 0 to Length(Chains) - 1 do
for J := 0 to Length(Chains[I]) - 1 do
Grid.Cells[I, J] := IntToStr(Chains[I, J]);
end;
procedure TForm1.ShowChain(const Chain: TChain; const Title: String);
var
I: Integer;
begin
if Length(Chain) = 0 then
Memo.Lines.Add('No ' + Title)
else
begin
Memo.Lines.Add(Title + ':');
for I := 0 to Length(Chain) - 1 do
Memo.Lines.Add(IntToStr(Chain[I]));
end;
end;
procedure TForm1.IntersectionButtonClick(Sender: TObject);
var
FillUp: Boolean;
Chains: TChains;
Chain: TChain;
begin
ClearGrid;
Memo.Clear;
FillUp := Sender = IntersectionFullButton;
if FillUp then
FillChains(Chains, True, 8)
else
FillChains(Chains, False, 4);
ShowChains(Chains);
Chain := GetChainsIntersection(Chains);
ShowChain(Chain, 'Intersection');
end;
procedure TForm1.DuplicatesButtonClick(Sender: TObject);
var
Chains: TChains;
Chain: TChain;
begin
ClearGrid;
Memo.Clear;
FillChains(Chains, Sender = DuplicatesFullButton, 900);
ShowChains(Chains);
Chain := GetDuplicateShackles(Chains);
ShowChain(Chain, 'Duplicates');
end;
initialization
Randomize;
end.
Unit1.DFM:
object Form1: TForm1
Left = 343
Top = 429
Width = 822
Height = 459
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
DesignSize = (
806
423)
PixelsPerInch = 96
TextHeight = 13
object Memo: TMemo
Left = 511
Top = 63
Width = 295
Height = 360
Anchors = [akLeft, akTop, akRight, akBottom]
ScrollBars = ssVertical
TabOrder = 5
end
object IntersectionFullButton: TButton
Left = 511
Top = 7
Width = 141
Height = 25
Caption = 'Intersection (full chains)'
TabOrder = 1
OnClick = IntersectionButtonClick
end
object Grid: TStringGrid
Left = 0
Top = 0
Width = 503
Height = 423
Align = alLeft
ColCount = 20
DefaultColWidth = 24
DefaultRowHeight = 20
FixedCols = 0
RowCount = 20
FixedRows = 0
TabOrder = 0
end
object DuplicatesFullButton: TButton
Left = 658
Top = 7
Width = 141
Height = 25
Caption = 'Duplicates (full chains)'
TabOrder = 3
OnClick = DuplicatesButtonClick
end
object IntersectionPartialButton: TButton
Left = 511
Top = 35
Width = 141
Height = 25
Caption = 'Intersection (partial chains)'
TabOrder = 2
OnClick = IntersectionButtonClick
end
object DuplicatesPartialButton: TButton
Left = 658
Top = 35
Width = 141
Height = 25
Caption = 'Duplicates (partial chains)'
TabOrder = 4
OnClick = DuplicatesButtonClick
end
end
if myarray[i][j] = myarray[j][k] then
Shouldn't that be
if myarray[i][k] = myarray[j][k] then
?
Anyway, the most obvious, simple optimization you can make to this code is changing this
for I := 0 to length(myarray)-1 do
begin
for J := 0 to length(myarray)-1 do
begin
if i = j then
continue;
into this
for I := 0 to length(myarray)-1 do
begin
for J := I+1 to length(myarray)-1 do
begin
My next step would be to get rid of the outer index expressions in the inner loop:
if myarray[i][j] = myarray[j][k] then
In the I and J loops, create pointers to two arrays of integers, then do
for I := 0 to length(myarray)-1 do
begin
pia := #myarray[i];
for J := I+1 to length(myarray)-1 do
begin
pja := #myarray[j];
Then in the inner loop you can do
if pia^[j] = pja^[k] then
Summarization:
Please check the comments below from David, Uwe, and other experts.
================================================================================
The following code swaps two rows in a two-dimensional, dynamic array of double values. I am wondering: (1) whether the following code is a best practice of swapping two rows of a two-dimensional array? If not, then what is the best practice to do this kind of job? (2) why would the following code work? I mean, isn't two-dimensional array a continuous contiguous section of memory? Does the following code work only by luck? Any suggestion is appreciated!
unit Unit5;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TAADouble = array of array of Double;
TForm5 = class(TForm)
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form5: TForm5;
procedure SwapRows(arr: TAADouble; row0, row1: Integer);
implementation
{$R *.dfm}
procedure SwapRows(arr: TAADouble; row0, row1: Integer);
var
Tmp: Integer;
begin
{$IFDEF FPC}
Tmp := PtrUInt(arr[row0]);
PtrUInt(arr[row0]) := PtrUInt(arr[row1]);
PtrUInt(arr[row1]) := Tmp;
{$ELSE}
Tmp := Integer(arr[row0]);
Integer(arr[row0]) := Integer(arr[row1]);
Integer(arr[row1]) := Tmp;
{$ENDIF}
end;
procedure TForm5.FormShow(Sender: TObject);
var
tmpArray: TAADouble;
I, J: Integer;
rowStr: string;
begin
SetLength(tmpArray, 10, 10);
rowStr := '';
for I := 0 to 9 do
for J := 0 to 9 do
tmpArray[I][J] := I * J;
for I := 0 to 9 do
begin
rowStr := '';
for J := 0 to 9 do
rowStr := rowStr + FloatToStr(tmpArray[I][J]) + ' ';
OutputDebugString(PWideChar(rowStr));
end;
SwapRows(tmpArray, 3, 4);
for I := 0 to 9 do
begin
rowStr := '';
for J := 0 to 9 do
rowStr := rowStr + FloatToStr(tmpArray[I][J]) + ' ';
OutputDebugString(PWideChar(rowStr));
end;
end;
end.
You ask:
Does the following code work only by
luck?
Well, yes, you are relying on implementation specific details.
In fact the correct way to write it is perfectly natural and simple:
type
TDoubleArray = array of Double;
TDoubleMatrix = array of TDoubleArray;
procedure SwapRows(M: TDoubleMatrix; Row1, Row2: Integer);
var
Temp: TDoubleArray;
begin
Temp := M[Row1];
M[Row1] := M[Row2];
M[Row2] := Temp;
end;
You need to declare an intermediate type for the row, TDoubleArray, so that you can perform the assignment to Temp in the swap routine.
A 2D constant size array
array [1..M] of array [1..N] of TMyType
is a contiguous block of memory.
A 2D dynamically size array as you have is not. Indeed it can even be ragged in the sense that the rows have different numbers of columns. So you can have, say, a triangular matrix.
A dynamic array is implemented as a pointer to a memory block representing that array. So a two-dimensional dynamic array is actually a pointer to an array of pointers. Thats why swapping the row(-pointer)s actually works.
See David's answer for a cleaner approach.
Update:
If you are allowed to use generics you might as well do this:
procedure <SomeClassOrRecord>.SwapRows<T>(var arr: TArray<T>; row0, row1: Integer);
var
Tmp: T;
begin
Tmp := arr[row0];
arr[row0] := arr[row1];
arr[row1] := Tmp;
end;