将多个任意排序的列表合并到一个列表中

Question

给出3个列表,这些列表由相同但未知的排序顺序任意排序.是否有一个算法将这些列表合并为一个然后按相同顺序排序的算法？

例:

清单1:a b c f h

清单2:b c e h

清单3:c d e f

假设这些列表已排序,但使用的排序顺序未知.我想将这些列表组合到一个不包含重复但仍保持排序顺序的结果中:a b c d e f h

如上所述:众所周知,给定的列表是排序的,但不知道哪个顺序,但要求是合并列表仍然按相同(未知)顺序排序.

在上面的例子中,我知道元素"f"位于"e"和"h"之间,因为从List1我知道

"c"<"f"<"h",

从List2我知道

"c"<"e"<"h"

从List3我知道

"e"<"f"和"c"<"e"

结合到:

"c"<"e"<"f"<"h"

如果任何给定列表无法确定排序顺序,则允许将元素附加到结果列表的末尾.此外,如果无法确定元素序列的排序顺序,只要它们位于正确的位置(例如,如果我知道"b"和"c"必须是在"a"和"d"之间插入,但我不知道它是否应该是abcd或acbd,那么两者都是允许的.)

当然这只是一个例子.实际列表较长(但包含少于100个元素),不包含单个但多个字符元素,并且排序顺序不是字母.另外,我最多有5个列表.

我需要在Delphi中实现这个算法(并且没有:这不是作业,而是现实生活中的问题),但是如果它不包含太多的编译器魔法或复杂的库函数,我会在一种语言中使用算法.

性能不是很大的问题,因为这样做了一次.

Answer 1

您的输入列表定义了项目的部分顺序.根据Math.SE的回答,你想要的是拓扑排序.维基百科上描述了算法.

Answer 2

好问题。尽管拓扑排序可能是最推荐的方法，但您必须首先解析输入以构建依赖项列表。我想到了一种更直接的方法，基于查找多个列表中出现的项目来设置订单定义。

我无法预测任何时间复杂度，但由于您不关心性能，特别是考虑到项目总数最多为 500，我认为该算法应该可以很好地工作。

算法

• 所有列表都放在一个临时列表中，然后自然排序，以便识别和筛选出所有重复的项目。这些重复项称为Keys，构成最终排序顺序的唯一定义。
• 通过比较每两个项目，Key 列表按输入排序顺序排序：如果两个 Key 出现在同一输入列表中，则该列表中的第一个 Key 也会出现在输出列表中的第二个 Key 之前。如果两个键没有同时出现在任何输入列表中，则它们被视为相等。
• 随后，循环遍历键。
• 在每个循环中，每个输入列表中前一个 Key 和当前 Key 之间的每个项目都会添加到输出列表中。一个循环以添加当前密钥而结束。

执行

type
  TSorterStringList = class(TStringList)
  protected
    Id: Integer;
    KeyId: Integer;
    function Current: String;
  public
    constructor Create;
  end;

  TSorterStringLists = class(TObjectList)
  private
    function GetItem(Index: Integer): TSorterStringList;
  public
    property Items[Index: Integer]: TSorterStringList read GetItem; default;
  end;

  TSorter = class(TObject)
  private
    FInput: TSorterStringLists;
    FKeys: TStringList;
    procedure GenerateKeys;
    function IsKey(const S: String): Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Sort(Output: TStrings);
    property Input: TSorterStringLists read FInput;
  end;

{ TSorterStringList }

constructor TSorterStringList.Create;
begin
  inherited Create;
  KeyId := -1;
end;

function TSorterStringList.Current: String;
begin
  Result := Strings[Id];
end;

{ TSorterStringLists }

function TSorterStringLists.GetItem(Index: Integer): TSorterStringList;
begin
  if Index >= Count then
    Count := Index + 1;
  if inherited Items[Index] = nil then
    inherited Items[Index] := TSorterStringList.Create;
  Result := TSorterStringList(inherited Items[Index]);
end;

{ TSorter }

constructor TSorter.Create;
begin
  inherited Create;
  FInput := TSorterStringLists.Create(True);
  FKeys := TStringList.Create;
end;

destructor TSorter.Destroy;
begin
  FKeys.Free;
  FInput.Free;
  inherited Destroy;
end;

threadvar
  CurrentSorter: TSorter;

function CompareKeys(List: TStringList; Index1, Index2: Integer): Integer;
var
  Input: TSorterStringLists;
  I: Integer;
  J: Integer;
  K: Integer;
begin
  Result := 0;
  Input := CurrentSorter.Input;
  for I := 0 to Input.Count - 1 do
  begin
    J := Input[I].IndexOf(List[Index1]);
    K := Input[I].IndexOf(List[Index2]);
    if (J > - 1) and (K > -1) then
    begin
      Result := J - K;
      Break;
    end;
  end;
end;

procedure TSorter.GenerateKeys;
var
  All: TStringList;
  I: Integer;
begin
  All := TStringList.Create;
  try
    All.Sorted := True;
    All.Duplicates := dupAccept;
    for I := 0 to FInput.Count - 1 do
      All.AddStrings(FInput[I]);
    for I := 0 to All.Count - 2 do
      if (All[I] = All[I + 1]) then
        if (FKeys.Count = 0) or (FKeys[FKeys.Count - 1] <> All[I]) then
          FKeys.Add(All[I]);
  finally
    All.Free;
  end;
  CurrentSorter := Self;
  FKeys.CustomSort(CompareKeys);
end;

function TSorter.IsKey(const S: String): Boolean;
begin
  Result := FKeys.IndexOf(S) > -1;
end;

procedure TSorter.Sort(Output: TStrings);
var
  KeyId: Integer;
  I: Integer;
  List: TSorterStringList;
begin
  if FInput.Count = 0 then
    Exit;
  Output.BeginUpdate;
  try
    GenerateKeys;
    for KeyId := -1 to FKeys.Count - 1 do
    begin
      for I := 0 to FInput.Count - 1 do
      begin
        List := FInput[I];
        if List.KeyId <= KeyId then
          while (List.Id < List.Count) and not IsKey(List.Current) do
          begin
            Output.Add(List.Current);
            Inc(List.Id);
          end;
        while (List.Id < List.Count) and IsKey(List.Current) do
        begin
          List.KeyId := FKeys.IndexOf(List.Current);
          Inc(List.Id);
        end;
      end;
      if KeyId + 1 < FKeys.Count then
        Output.Add(FKeys[KeyId + 1]);
    end;
  finally
    Output.EndUpdate;
  end;
end;

用法示例

procedure TForm1.Button1Click(Sender: TObject);
var
  Sorter: TSorter;
begin
  Sorter := TSorter.Create;
  try
    Sorter.Input[0].CommaText := '1, 2, 4, 9, 10, 11, 22, 46, 48, 51, 70, 72';
    Sorter.Input[1].CommaText := '3, 9, 23, 43, 44, 45, 47, 48, 51, 71, 90, 91';
    Sorter.Input[2].CommaText := '0, 3, 4, 7, 8, 11, 23, 50, 51, 52, 55, 70';
    Sorter.Input[3].CommaText := '2, 6, 14, 15, 36, 37, 38, 39, 51, 65, 66, 77';
    Sorter.Input[4].CommaText := '5, 27, 120, 130';
    ListBox1.Items.Assign(Sorter.Input[0]);
    ListBox2.Items.Assign(Sorter.Input[1]);
    ListBox3.Items.Assign(Sorter.Input[2]);
    ListBox4.Items.Assign(Sorter.Input[3]);
    ListBox5.Items.Assign(Sorter.Input[4]);
    Sorter.Sort(ListBox6.Items);
    // Results in:
    // 1, 0, 5, 27, 120, 130, 3, 2, 6, 14, 15, 36, 37, 38, 39, 4, 7, 8, 9, 10,
    // 11, 22, 46, 23, 43, 44, 45, 47, 50, 48, 51, 71, 90, 91, 52, 55, 65, 66,
    // 77, 70, 72
  finally
    Sorter.Free;
  end;
end;

Answer 3

图论似乎是一个很好的第一直觉。

您可以构建一个有向图，其中列表的元素是顶点，并插入从每个列表元素到其后继元素的有向边。那么当且仅当可以通过遍历图从 A 到达 B 时，节点 A小于另一个节点 B。

图中的循环（A 小于 B 并且 B 小于 A）表示输入数据损坏或存在两个具有不同名称的等效元素。

在没有循环的情况下，在给定的小于关系下进行合并应该很简单：重复删除图中任何其他节点都无法到达的节点，并将它们添加到输出列表中。