Delphi

Question

使用：Delphi 10.2 东京

请 link 给我一个算法或代码，从多个集合中获取所有可能的值组合，每个集合一个值。事先不知道集合的数量，也不知道每个集合中值的数量。

示例：

1. (1, 2, 3) (A, B)
Desired result: 
1 A
1 B
2 A
2 B
3 A
3 B

2. (1, 2, 3, 4) (A, B) (X, Y, Z)
Desired result: 
1 A X
1 A Y
1 A Z
2 A X
2 A Y
2 A Z
3 A X
3 A Y
3 A Z
4 A X
4 A Y
4 A Z
1 B X
1 B Y
1 B Z
2 B X
2 B Y
2 B Z
3 B X
3 B Y
3 B Z
4 B X
4 B Y
4 B Z

提前致谢！

Answer 1

二维数组A元素的笛卡尔积的递归和迭代生成（有存储和无存储）

var
  A: array of array of Integer;
  B: array of array of Integer;
  i, j: Integer;
  s: string;
  NN: Integer;

  procedure CartesianRec(From: Integer; cs: string);
  var
    j: integer;
  begin
    if From = Length(A) then
      Memo1.Lines.Add(cs)
    else
      for j := 0 to High(A[From]) do
        CartesianRec(From + 1, cs + IntToStr(A[From, j]) + ' ');
  end;

  procedure CartesianIter;
  var
    i, j, k, l, c, N, M: Integer;
  begin
    NN := 1;
    for k := 0 to High(A) do
      NN := NN * Length(A[k]);
    SetLength(B, NN, Length(A));
    N := NN;
    M := 1;
    for k := 0 to High(A) do begin
      N := N div Length(A[k]);
      c := 0;
      for l := 0 to M - 1 do
        for i := 0 to High(A[k]) do
          for j := 0 to N - 1 do begin
            B[c, k] := A[k, i];
            Inc(c);
          end;
      M := M * Length(A[k]);
    end;
  end;

  procedure CartesianOnline;
  var
    i, j, k, l, c, N, M, dimA: Integer;
    s: string;
  begin
    NN := 1;
    dimA := Length(A);
    //SetLength(CartProduct, dimA);
    for k := 0 to dimA - 1 do
      NN := NN * Length(A[k]);
    for i := 0 to NN - 1 do begin
      j := i;
      s := '';
      for k := dimA - 1 downto 0 do begin
        l := j mod Length(A[k]);
        s := IntToStr(A[k][l]) + ' ' + s;
        //we can also put CartProduct[k] := A[k][l];
        j := j div Length(A[k]);
      end;
      Memo1.Lines.Add(s);
      //or use CartProduct
    end;
  end;

  begin
  nn := 1;
  SetLength(A, 3);
  for i := 0 to High(A) do begin
    SetLength(A[i], 5 - i);
    s := '';
    for j := 0 to High(A[i]) do begin
      A[i, j] := nn;
      Inc(nn);
      s := s + IntToStr(A[i, j]) + ' ';
    end;
    Memo1.Lines.Add(s);
  end;
  Memo1.Lines.Add('------');
  CartesianRec(0, '');
  Memo1.Lines.Add('------');
  CartesianIter;
  for i := 0 to NN - 1 do begin
    s := '';
    for j := 0 to High(A) do
      s := s + IntToStr(B[i, j]) + ' ';
    Memo1.Lines.Add(s);
  end;
  Memo1.Lines.Add('------');
  CartesianOnline;

甲：

1 2 3 4 5 
6 7 8 9 
10 11 12

结果：

Answer 2

我使用了 TLists 和 Integer 数组并设法解决了这个问题。这是我的代码：

uses Classes, SysUtils, Generics.Collections;

type
  TIntArray = array of integer;

  TIntArrayList = TList<TIntArray>;

  TCartesianProduct = class
  private
    FSetList: TIntArrayList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddSet(ASet: TIntArray);
    procedure GetCombinations(var AIntArrayList: TIntArrayList);
  end;

implementation

{ TCartesianProduct }

constructor TCartesianProduct.Create;
begin
  FSetList := TIntArrayList.Create;
end;

destructor TCartesianProduct.Destroy;
begin
  FSetList.Free;
end;

procedure TCartesianProduct.AddSet(ASet: TIntArray);
begin
  FSetList.Add(ASet);
end;

procedure TCartesianProduct.GetCombinations(var AIntArrayList: TIntArrayList);
var
  WorkList, OuputList: TIntArrayList;
  r: TIntArray;
  n, c, l: integer;
  f: Boolean;
begin

  WorkList := TIntArrayList.Create; // Length of each set array, and current iteration index
  OuputList := TIntArrayList.Create;
  try
    n := FSetList.Count;

    for c := 0 to n - 1 do
      WorkList.Add([Length(FSetList[c]), 0]);

    while ((WorkList[0][1] < WorkList[0][0])) do
    begin

      SetLength(r, n); // result array length is the number of sets

      for c := 0 to FSetList.Count - 1 do
      begin
        r[c] := FSetList[c][WorkList[c][1]];
      end;

      Inc(WorkList[n - 1][1]); // last work list item (set)
      if (WorkList[n - 1][1] = WorkList[n - 1][0]) and (n - 1 <> 0) then // if it equal the length of the set
      begin
        WorkList[n - 1][1] := 0; // then reset it back to zero

        l := n - 1; // make pointer point to previous item up
        f := false;
        repeat
          Dec(l);

          if (l >= 0) then
          begin
            Inc(WorkList[l][1]); // increase index in previous item
            if (l <> 0) and (WorkList[l][1] = WorkList[l][0]) then
            begin
              WorkList[l][1] := 0; // If that items pointer points to the last item, reset it to zero
            end
            else
              f := true;
          end
          else
            f := true;

        until f;

      end;

      OuputList.Add(r);
    end;

    AIntArrayList.Clear;
    for c := 0 to OuputList.Count - 1 do
      AIntArrayList.Add(OuputList[c]);

  finally
    OuputList.Free;
    WorkList.Free;
  end;

end;

使用以下代码进行测试：

procedure TfmMain.btTestClick(Sender: TObject);
 var
 intset1, intset2, intset3: TIntArray;
 outsetlist: TIntArrayList;
 CP: TCartesianProduct;
 c, d: Integer;
 l: string;
begin
   SetLength(intset2, 4);
   SetLength(intset3, 4);
  
   intset2[0] := 105;
   intset2[1] := 106;
   intset2[2] := 107;
   intset2[3] := 108;
  
   intset3[0] := 109;
   intset3[1] := 110;
   intset3[2] := 111;
   intset3[3] := 112;
  
   outsetlist := TIntArrayList.Create;
   CP := TCartesianProduct.Create;
   try
   CP.AddSet(intset2);
   CP.AddSet(intset3);
  
   CP.GetCombinations(outsetlist);
  
   ListBox1.Clear;
  
   for c := 0 to outsetlist.Count - 1 do
   begin
   l := '';
   for d := 0 to high(outsetlist[c]) do
   l := l + Format('%d ', [outsetlist[c][d]]);
  
   ListBox1.Items.Add(l);
   end;
  
   finally
   CP.Free;
   outsetlist.Free;
   end;
end;

Delphi - 从多个集合中获取组合

Delphi - Get combinations from multiple sets

combinations

set