En algoritme ide ønskes

Hvis du sorterer hver enkelt liste, bør du kunne lave noget der minder om en ekstern mergesort for at løbe igennem dem parallelt. I stedet for at sorterer i det sidste trin, skal du så bare søge gennem listerne indtil du når den værdi du er ude efter (start med første listes første værdi, og fortsæt derefter med maksimumværdien). Når de alle når til samme værdi, har du et match som du kan smide ind i Resultlist, hvorefter du tvinger en af listerne en enkelt tak frem.

Hvis der kan være dubletter inden for samme liste, skal du så håndtere dette når du tvinger listen en tak frem - eksempelvis med en speciel metode der søger fremad indtil den når en anden værdi end den før, eller ved at fjerne dubletter på forhånd.

Ved opslag kan det måske betale sig at bruge en THashedStringList (IniFiles), men et alternativ er at hælde alle strengene over i resultatlisten, sortere den og derefter gennemløbe den bagfra og slette alle de der ikke forekommer 5 gange.

procedure TfrmMain.btnTestClick(Sender: TObject);
var
  i, c1, c2, delta : integer;
  Found : boolean;
  st : string;
begin
  c2 := lbResult.Items.Count - 1; c1 := c2;
  repeat
    st := lbResult.Items[c2]; Found := true;
    while (c1 > 0) and Found do
    begin
      dec(c1);
      Found := AnsiSameText(st,lbResult.Items[c1]);
    end;

    if Found then
      dec(c1);

    delta := c2 - c1;

    if delta < 5 then // All
    begin
      for i := delta downto 1 do
        lbResult.Items.Delete(c1 + i);
    end
    else begin // All but one
      for i := delta downto 2 do
        lbResult.Items.Delete(c1 + i);
    end;
    c2 := c1;
  until c2 < 0;
end;

I eksemplet bruger jeg ListBokse. Husk at sætte Items.BeginUpdate og Items.EndUpdate før du kører. En god måde at kopiere listerne over i en er AddStrings

procedure TfrmMain.FormCreate(Sender: TObject);
var
  i : integer;
begin
  for i := 0 to 50 - 1 do
  begin
    lb1.Items.Add(IntToStr(random(100)));
    lb2.Items.Add(IntToStr(random(100)));
    lb3.Items.Add(IntToStr(random(100)));
    lb4.Items.Add(IntToStr(random(100)));
  end;

  lbResult.Items.AddStrings(lb1.Items);
  lbResult.Items.AddStrings(lb2.Items);
  lbResult.Items.AddStrings(lb3.Items);
  lbResult.Items.AddStrings(lb4.Items);
end;

Jeg antager at listerne kun indeholder een instans af samme streng (der er en property der kan styre dette igIgnoreDuplicates eller sådan noget).

Alternativt kan du lave et objekt der indeholder strengen og en tæller:

TLineData = class
private
  fLine : string;
  fCount : integer;
public
  constructor Create(const aLine : string);
  property Line : string read fLine;
  property Count : integer read fCount;
  procedure IncreaseCount;
end;

TLineList = class(TObjectList)
private
  procedure SortByLine;
  function BinarySearch(const aString : string) : integer;
  function TLineList.GetLineData(const aIndex : integer) : TLineData;
public
  property Items[const aIndex : integer] : TLineData read GetLineData; default;
  function Add(const aString : string) : integer; override;
  procedure Export(aLines : TStrings; const aCount : integer);
end;

implementation

function CompareByLine(aP1, aP2 : pointer) : integer;
var
  ld1, ld2 : TLineData;
begin
  ld1 := aP1; ld2 := aP2;
  result := AnsiCompareStr(ld1.Value,ld2.Value);
end;

procedure TLineList.SortByLine;
begin
  Sort(CompareByLine);
end;

function TLineListBinarySearch(const aString : string) : integer;
begin
  result := -1;
  // Implementér en binær søgning
end;

function TLineList.GetLineData(const aIndex : integer) : TLineData;
begin
  result := inherited Items[aIndex] as TLineData;
end;

function TLineList.Add(const aString : string) : integer;
begin
  result := BinraySearch(aString);
  if result < 0 then
    result := inherited Add(TLineData.Create(aString)
  else
    Items[result].IncrementCount;
end;

procedure TLineList.Export(aLines : TStrings; const aCount : integer);
var
  i : integer;
  LineData : TLineData;
begin
  aLines.BeginUpdate;
  try
    aLines.Clear;
    for i := 0 to Count - 1 do
    begin
      LineData := Items[i];
      if LineData.Count >= aCount then
        aStrings.Add(LineData.Line);
    end;
  finally
    aStrings.EndUpdate;
  end;
end;

constructor TLineData.Create(const aLine : string);
begin
  inherited Create;
  fLine := aLine;
  fCount := 1;
end;

procedure TLineData.IncreaseCount;
begin
  inc(fCount);
end;

Hold da op!. Det spørgsmål var vist lige i din boldgade hrc.
Sidste svar er helt kanon