具有合并功能的组合和排列

Question

我有 n 个字符串，我需要将它们合并成多个 combinations/permutations 中的 n 个字符串。字符串不能重复自身，单个合并中的组合无关紧要 ( S1, S2 ) = ( S2, S1 )...

这在构建树模型时使用，它决定了哪种特征组合最适合合并...

这段代码是我为排列而写的。列表包含特征属性，Splits 是我要进行的拆分数，SplitList return 哪些属性需要合并在一起...对于二叉树，我输入“2”作为拆分，对于非二叉树，我运行一个循环到 return 每个拆分的最佳值。

I.E. 我有 "A"、"B"、"C"、"D"、"E"、"F"。如果我需要合并成 2 个字符串 2. "A,B,C" 和 "D,E,F" 或 "A,C,E" 和 "B,D,F" 或 "A,E,F" 和 "B,C,D" 3. "A,B, and "C,D" 和 "E,F" 或 "A,D" 和 "C,B" 和 "E,F" 字符串中的最小数字也是 1，最大 n-1。 IE 2. "A" and "B,C,D,E,F" or "C" and "A,B,D,E,F" 是有效合并

function TSplitEngine.doTest(List: TList; Splits: Integer; var SplitList : TArray<Integer>): Double;
var
   i, j, SplitNo, Pointer : Integer;
   tmpNode : TDTreeNode;
   CurRes, CurOut : Double;
   TestArr : RTestArr;
   ResArr: TArray<double>;
   SplitStr : String;
   DoSplit, FindSplit : Boolean;
   TestList : TArray<Integer>;
begin
   Result := DefaultVal;
   SetLength( TestList, Splits );
   for i := 0 to Length( TestList ) - 1 do
       TestList[ i ] := i + 1;
   TestArr.Size := Splits + 1;
   DoSplit := True;
   while DoSplit do
   begin
      Inc(Iteration);
      TestArr.Clear;
      for i := 0 to List.Count - 1 do
      begin
          tmpNode := TDTreeNode( List[ i ] );
          j := 0;
          FindSplit := True;
          While ( j < Length( TestList ) ) and ( FindSplit )  do
          begin
             if i < TestList[ j ] then
             begin
                Combine Characteristics
                FindSplit := False;
             end
             else if ( i >= TestList[ Length( TestList ) - 1 ] ) then
             begin
                Combine  last split characteristics
                FindSplit := False;
             end;
             inc( j );
          end;
          TestArr.AllTotal := TestArr.AllTotal + ( tmpNode.Goods + tmpNode.Bads );
      end;
      //CalcNode returns the result of this particular splits
      CurRes := CalcNode( TestArr );
      SetLength( ResArr, 2 );
      ResArr[ 1 ] := CurRes;

      if IsBetter( CurRes, Result ) then
      begin
         Result := CurRes;
         SplitList := Copy( TestList, 0, Length( TestList ) );
      end;
      SplitNo := 1;
      FindSplit := True;
      //Move the split like a pointer...
      i  := Length( TestList ) - 1;
      while ( i >= 0 ) and FindSplit do
      begin
         if ( TestList[ i ] < ( List.Count - SplitNo ) ) then
         begin
            Pointer := TestList[ i ] + 1;
            for j := i to Length( TestList ) - 1 do
            begin
               TestList[ j ] := Pointer;
               inc( Pointer );
            end;

            FindSplit := False;
         end
         else if ( i = 0 ) then
            DoSplit := False;
         inc ( SplitNo );
         Dec( i );
      end;
   end;
end;

排列代码似乎有效，唯一要做的就是整理它。

我已经尝试过几次将此代码转换为进行组合，但似乎从未奏效。

Answer 1

我有用于生成集合大小 <= 10 的集合分区的旧代码（由于集合比较是通过字符串实现的）。请注意，n=10 的分区数是 115975（贝尔号）。

程序将集合的非重复分区生成 KP 部分，因此您必须遍历所有 KP 值。

部分输出包括一些两部分和一些三部分分区：

1,4 | 2,3,5 | 
1,4,5 | 2,3 | 
1,5 | 2,3,4 | 
1 | 2 | 3,4,5 | 
1 | 2,3 | 4,5 | 
1 | 2,3,4 | 5 | 

  procedure generate_multi_partitions(values: array of Integer; KP: Integer);
  var
    n, i: Integer;
    avail: array of Boolean;
    output: array of TStringList;

  procedure foo(k: Integer); forward;

    procedure bar(k, i: Integer);
    var
      j: Integer;
    begin
      output[k].add(IntToStr(values[i]));
      avail[i] := False;
      foo(k + 1);
      for j := i + 1 to n - 1 do
        if avail[j] and ((j = 0) or (values[j - 1] <> values[j]) or
          (not avail[j - 1])) then
          bar(k, j);
      output[k].Delete(output[k].Count - 1);
      avail[i] := True;
    end;

    procedure foo(k: Integer);
    var
      i, j: Integer;
      s: string;
    begin
      if (k >= 2) and (output[k - 2].CommaText > output[k - 1].CommaText) then
        Exit;
      if k = KP - 1 then begin
        output[k].Clear;
        for i := 0 to n - 1 do
          if avail[i] then
            output[k].add(IntToStr(values[i]));
        if (output[k].Count > 0) and
          ((k = 0) or (output[k - 1].CommaText <= output[k].CommaText)) then
        begin
          s := '';
          for j := 0 to KP - 1 do
            s := s + output[j].CommaText + ' | ';
          Memo1.Lines.add(s);
        end;
        output[k].Clear;
      end
      else
        for i := 0 to n - 1 do
          if avail[i] then begin
            bar(k, i);
            Exit;
          end;
    end;

  begin
    n := length(values);
    SetLength(avail, n);
    SetLength(output, KP);
    for i := 0 to KP - 1 do
      output[i] := TStringList.Create;
    for i := 0 to n - 1 do
      avail[i] := True;
    foo(0);
    for i := 0 to KP - 1 do
      output[i].Free;
  end;

var
  parts: Integer;
begin
  for parts := 1 to 5 do
    generate_multi_partitions([1, 2, 3, 4, 5], parts);
end;

具有合并功能的组合和排列

Combination and Permutation with merging function

delphi

merge

combinations

permutation

delphi-10.2-tokyo