Класс целочисленных списков TIntList

Автор: Владимир Коднянко, королевство Delphi

В Delphi есть класс TStringList для работы со списком строк, который использую весьма часто. Не реже, если не чаще, приходится обращаться к целочисленным массивам. Однако класса, подобного TStringList, или достаточно полного набора алгоритмов по работе с целочисленными массивами не нашел. Предлагаемый класс TIntList, быть может, окажется полезным не только мне. Надеюсь, заинтересованные читатели поделятся своими замечаниями, выскажут предложения по улучшению кода, возможно, обнаружат ошибки и сообщат о них.

Ядром класса является массив целых с пользовательским типом TIntVec. Кроме него используются две переменные FSorted (-1 - массив отсортирован по невозрастанию/убыванию, 0 - не сортирован, 1 - отсортирован по неубыванию/возрастанию) и FCompressed (true - массив не содержит одинаковых элементов). Имена подпрограмм дают достаточное представление о их назначении, тем не менее некоторым из них необходимо дать краткое пояснение.

Несколько примеров использования класса для var q, w: TIntList; s: String; j1, j2: Integer.

Пример практического использования списка TIntList (задача, сформулированная на DelphiKingdom в рубрике Головоломки, вопрос №58913). Дан массив слов. Необходимо построить из них цепочку, в которой каждое последующее слово начинается с той же буквы, на которую оканчивается предыдущее.

Идея алгоритма основана на последовательном включении в цепочку тех слов, которые отвечают критерию расстановки и ранее в цепочке не использовались.

function FindChain(a: array of String): boolean;
  var Need: boolean; n,i: Integer; t: TIntList;
// ------------------------------------------------

function Compare(a,b: String): boolean;
begin
  Result:= (Length(a)>0) and (Length(b)>0) and (a[Length(a)] = b[1]);

end;
// ------------------------------------------------
procedure Recurse(s: String; t: TIntList; k: Integer); // рекурсия
  var j,i: Integer; g: TIntList;
begin

  for j:= 0 to n-1 do
   if not Need then break else

   if Compare(a[t[t.Count-1]],a[j]) and (t.IndexOf(j) = -1) then
    begin
     i:= k+1; g:= t.AddList(j); Need:= i < n;
     if Need then Recurse(s+' '+a[j],g,i) else ShowMessage(s+' '+a[j]);
     g.Free;
   end;

end;
// ------------------------------------------------
begin
  Need:= true; n:= Length(a); Result:= n<2;
  if not Result then

    begin
      t:= TIntList.Create;
      for i:= 0 to n-1 do

       if Need then
        begin
          t.AssignInt(i);
          Recurse(a[i]+' ',t,1);
        end else break;
      t.Free;
     Result:= not Need;
    end;

end;

Следующий код

procedure TForm1.Button1Click(Sender: TObject);
var a: array of String;

begin
  SetLength(a,10);
  a[0]:= 'ствол'; a[1]:= 'канва'; a[2]:= 'лак'; a[3]:= 'коралл'; 
  a[4]:= 'перец'; a[5]:= 'ананас'; a[6]:= 'цветок'; a[7]:= 'ларец'; 
  a[8]:= 'лес'; a[9]:= 'сироп';
  if not FindChain(a) then ShowMessage('Нет цепочки слов.');
  a:= Nil;

end;

даст требуемую цепочку слов 'лак канва ананас ствол ларец цветок коралл лес сироп перец' (первая результативная перестановка 2150763894).

Если необходимо получить все цепочки, отвечающие условию задачи, то после незначительной модификации кода алгоритм покажет, что для данного примера из ровно 14 (последняя результативная перестановка 8946321507).