В Delphi есть класс TStringList для работы со списком строк, который использую весьма часто. Не реже, если не чаще, приходится обращаться к целочисленным массивам. Однако класса, подобного TStringList, или достаточно полного набора алгоритмов по работе с целочисленными массивами не нашел. Предлагаемый класс TIntList, быть может, окажется полезным не только мне. Надеюсь, заинтересованные читатели поделятся своими замечаниями, выскажут предложения по улучшению кода, возможно, обнаружат ошибки и сообщат о них.
Ядром класса является массив целых с пользовательским типом TIntVec. Кроме него используются две переменные FSorted (-1 - массив отсортирован по невозрастанию/убыванию, 0 - не сортирован, 1 - отсортирован по неубыванию/возрастанию) и FCompressed (true - массив не содержит одинаковых элементов). Имена подпрограмм дают достаточное представление о их назначении, тем не менее некоторым из них необходимо дать краткое пояснение.
property Count: Integer read FCount;
число элементов массива;
property Sorted: Integer read FSorted;
упомянутый призак сортировки;
property Compressed: boolean read FCompressed;
содержит ли повторяющиеся элементы;
procedure AddInt(L: Integer); overload; dynamic;
добавляет элемент;
procedure Add(L: array of Integer); overload; dynamic;
добавляет массив;
procedure Add(L: TIntList); overload; dynamic;
добавляет список;
function Add(s: String): Integer; overload;
выделяет целые из строки и добавляет их;
function AddIntList(L: Integer): TIntList; overload; dynamic;
то же с созданием списка;
function AddIntAsNew(L: Integer): boolean; virtual;
добавляет целое, если его в списке нет;
procedure Assign(L: TIntList); overload; dynamic;
очистка и добавление
function AsString: String; virtual;
строка констант с разделителем-пробелом;
function Average: Extended; virtual;
среднее арифметическое;
function Change(L1, L2: TIntList): Integer; overload; virtual;
замена L1 на L2 всюду;
function ChangeList(L1, L2: TIntList): TIntList; overload;
то же с созданием списка;
procedure Clear;
очистка списка;
procedure Compress; virtual;
удаление повторяющихся элементов;
procedure Copy(Index, Count: Integer);
копирование фрагмента массива;
procedure Delete(Index: Integer); virtual;
удаление элемента;
function DeleteAll(L: Integer): Integer; virtual;
удаление элементов, равных L;
function DeleteFirst(L: Integer): boolean; virtual;
удаление первого, равного L;
function DeleteLast(L: Integer): boolean; virtual;
Пример практического использования списка 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;
Если необходимо получить все цепочки, отвечающие условию задачи, то после незначительной модификации кода алгоритм покажет, что для данного примера из ровно 14 (последняя результативная перестановка 8946321507).
