Arrays Delphi中N个数组的交集

为了找到N个数组的交集，我使用了这个实现，它的效率非常低。我知道必须有一个算法来加速这个过程

注意：myarray是包含我要为其查找交点的所有其他数组的数组

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;

我可以应用什么优化来加快速度？有没有更快的方法

---

编辑：数组中的数据未排序。

有一种更快的方法：列表比较算法。它允许您在线性时间而不是二次时间内比较两个列表。基本思路如下：

按相同标准对两个列表进行排序。（如果需要保留原始顺序，请先复制列表。）

从两个列表的顶部开始。从每个项目中选择第一项并进行比较

如果两个列表匹配，则处理该案例并提升两个列表的索引

如果它们不匹配，则循环执行，每次使用“较小”值推进列表的索引，直到找到匹配项

当您到达任一列表的末尾时，您就完成了。（除非您想处理其他列表中的任何剩余内容。）

这可以扩展到处理两个以上的列表，只需稍加努力

if myarray[i][j] = myarray[j][k] then

难道不是吗

if myarray[i][k] = myarray[j][k] then

?

无论如何，您可以对这段代码进行的最明显、最简单的优化就是更改

for I := 0 to length(myarray)-1 do
  begin
    for J := 0 to length(myarray)-1 do
    begin
      if i = j then
        continue;

进入这个

for I := 0 to length(myarray)-1 do
  begin
    for J := I+1 to length(myarray)-1 do
    begin

我的下一步是去掉内部循环中的外部索引表达式：

if myarray[i][j] = myarray[j][k] then

在I和J循环中，创建指向两个整数数组的指针，然后执行以下操作

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];

然后在内部循环中，您可以执行以下操作

if pia^[j] = pja^[k] then

---

不幸的是，您还没有更新您的问题，因此仍然不清楚您在问什么。例如，您谈到一个交集（它应该搜索存在于每个数组中的值），但从（不起作用的）代码来看，您似乎只是在搜索任何数组中的重复项

虽然这类算法有一个明显的通用解决方案，但我相信对于这样一个多维数组来说，情况有所不同。我制定了两个程序来确定（1）交叉点和（2）重复点。两者都假定数组中长度不等的无序内容

首先，我决定引入一些新类型：

type
  PChain = ^TChain;
  TChain = array of Integer;
  TChains = array of TChain;

其次，这两个例程都需要一些排序机制。通过使用/误用

t列表

，可以完成一个快速但肮脏的任务：

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;

但是，通过调整

Classes.QuickSort

中的RTL代码，可以获得更好的实现，它与上面的实现完全相同，无需复制数组（两次）：

过程排序链（链：PChain；L，R：整数）；
变量
I：整数；
J：整数；
值：整数；
温度：整数；
开始
重复
I:=L；
J:=R；
值：=链^[（L+R）shr 1]；
重复
而链^[I]Value do
12月（J）；
如果I J；
如果L=R；
结束；

交叉： 要获得所有数组的交集，将最短数组中的所有值与所有其他数组中的值进行比较就足够了。因为最短的数组可能包含重复的值，所以对该小数组进行排序，以便能够忽略重复的值。从这一点上讲，只需在其他数组中查找（或者说诺特查找）相同的值。不需要对所有其他数组进行排序，因为在排序后的数组中，在较早的位置找到值的几率为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;

函数GetChainsIntersection（常量链：TChains）：TChain；
变量
IShortest：整数；
I：整数；
J：整数；
K：整数；
值：整数；
发现：布尔型；
FindCount：整数；
开始
//确定哪条链最短
IShortest:=0；
对于I:=1到长度（链）-1 do
如果长度（链[I]）<长度（链[IShortest]），则
IShortest:=I；
//结果的长度最大为最短链的长度
设置长度（结果，长度（链[IShortest]）；
值：=0；
FindCount:=0；
//查找最短链中的每个值。。。
SortChain（@Chains[IShortest]，0，长度（Chains[IShortest]）-1）；
对于K:=0到长度（链[IShortest]）-1 do
开始
如果（K>0）和（链[IShortest，K]=值），则
继续；
值：=链[IShortest，K]；
发现：=假；
对于I:=0到长度（链）-1 do
如果我是最棒的
开始
发现：=假；
对于J:=0到长度（链[I]）-1do
// ... 其他链中的值相同
如果链[I，J]=值，则
开始
发现：=真；
打破
结束；
如果没有找到的话
打破
结束；
//将找到的值添加到结果中
如果找到了
开始
结果[FindCount]：=值；
公司（FindCount）；
结束；
结束；
//将结果长度截断为找到的实际值数
SetLength（结果，FindCount）；
结束；

副本： 这也不需要对所有数组进行单独排序。所有值都复制到一维临时数组中。对thát数组进行排序后，很容易找到重复项

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;

函数GetDuplicateShackles（常量链：TChains）：TChain；
变量
计数：整数；
I：整数；
温度：TChain；
值：整数；
开始
//预见不到结果
SetLength（结果为0）；
//计算值的总数
计数：=0；
对于I:=0到长度（链）-1 do
Inc（计数、长度（链[I]）；
如果计数>0，则
开始
//将所有值复制到临时链。。。
设置长度（温度、计数）；
计数：=0；
对于I:=0到长度（链）-1 do
开始
移动（链[I][0]、温度[Count]、长度（链[I]）*SizeOf（整数））；
Inc（计数、长度（链[I]）；
结束；
//对临时链进行排序
SortChain（@Temp，0，Count-1）；
//查找临时链中的所有重复值
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;

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