如何生成TStringList中字符串的无重复全排列组合（1到N个）

需求说明 #

我有数量未知的单词，存储在TStringList对象中，代码示例如下：

var
  input_list: TStringList;
begin
  input_list := TStringList.Create;
  input_list.Add('Mark');
  input_list.Add('Anna');
  input_list.Add('John');
  input_list.Add('Martha');
  ...
end;

需要生成一个新列表，包含这些单词从1个到N个的所有可能排列（分隔符可自定义）。例如当N=3时，输出示例如下：

N = 3
'Mark'
'Anna'
'Mark Anna'
'Anna Mark'
'Mark John'
'John Mark'
'Mark Anna John'
'John Anna Mark'
'Anna John Mark'
...

需满足两个要求：

• 顺序不同的组合视为不同（如Mark Anna与Anna Mark都需包含）
• 组合中无重复元素（如Mark Mark这类情况不允许出现）

有没有简便的实现方法，比如类似procedure_permutate(list_of_strings)的过程？

实现方案 #

可以通过递归方式实现这个需求，下面是完整的Delphi过程代码：

procedure PermutateAllLengths(const InputList: TStringList; MaxLength: Integer; OutputList: TStringList);
var
  procedure GeneratePermutations(CurrentPerm: string; UsedIndices: array of Boolean; CurrentLength: Integer);
  var
    i: Integer;
    NewPerm: string;
    NewUsed: array of Boolean;
  begin
    // 当前排列长度≥1时，加入输出列表
    if CurrentLength >= 1 then
      OutputList.Add(CurrentPerm);
    // 达到最大长度则停止递归
    if CurrentLength >= MaxLength then
      Exit;

    // 复制已使用索引状态
    SetLength(NewUsed, InputList.Count);
    for i := 0 to High(UsedIndices) do
      NewUsed[i] := UsedIndices[i];

    // 遍历所有未使用元素，生成新排列
    for i := 0 to InputList.Count - 1 do
    begin
      if not NewUsed[i] then
      begin
        NewUsed[i] := True;
        // 拼接新排列，分隔符可按需修改
        if CurrentPerm = '' then
          NewPerm := InputList[i]
        else
          NewPerm := CurrentPerm + ' ' + InputList[i];
        // 递归生成更长的排列
        GeneratePermutations(NewPerm, NewUsed, CurrentLength + 1);
        // 回溯，恢复元素未使用状态
        NewUsed[i] := False;
      end;
    end;
  end;

var
  Used: array of Boolean;
begin
  OutputList.Clear;
  if (InputList = nil) or (InputList.Count = 0) or (MaxLength < 1) then
    Exit;

  // 初始化已使用索引数组
  SetLength(Used, InputList.Count);
  GeneratePermutations('', Used, 0);
end;

使用示例 #

var
  input_list, output_list: TStringList;
begin
  input_list := TStringList.Create;
  output_list := TStringList.Create;
  try
    input_list.Add('Mark');
    input_list.Add('Anna');
    input_list.Add('John');
    // 生成1到3长度的所有排列
    PermutateAllLengths(input_list, 3, output_list);
    // 输出结果
    Writeln('N = 3');
    for var s in output_list do
      Writeln(QuotedStr(s));
  finally
    input_list.Free;
    output_list.Free;
  end;
end;

关键说明 #

• 外层过程负责初始化参数，调用内部递归函数生成排列
• 递归函数通过UsedIndices数组跟踪已选元素，避免重复选取
• 分隔符可自由修改（比如换成逗号，只需调整NewPerm的拼接逻辑）
• 若输入列表为空或MaxLength小于1，直接返回空列表

内容的提问来源于stack exchange，提问作者kwadratens