Владимир Коднянко
дата публикации 22-05-2008 10:56 Класс целочисленных списков TIntList
В 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; | удаление последнего, равного L; |
| procedure DeleteRange(Index1, Index2: Integer); virtual; | удаление фрагмента; |
| function FindMax(var Index: Integer): boolean; virtual; | поиск наибольшего элемента; |
| function FindMin(var Index: Integer): boolean; virtual; | поиск наименьшего элемента; |
| function GetIntVec: TIntVec; dynamic; | возвращает массив; |
| function IndexOf(L: TIntList): Integer; overload; virtual; | индекс элемента, массива, списка |
| function IndexesOf(L: TIntList): TIntList; overload; virtual; | список индексов; |
| function IntCount(L: TIntList): Integer; overload; virtual; | количество вхождений; |
| function IntCount2(L: TIntList): Integer; overload; virtual; | количество непересекающихся вхождений; |
| function Insert(L: TIntList; Index: Integer): boolean; overload; | вставка с указанного места; |
| function InsertList(L: TIntList; Index: Integer): TIntList; overload; | то же с созданием списка |
| function IsEqual(b: TIntList): boolean; virtual; | проверка на совпадение; |
| function Module: Extended; virtual; | модуль математического вектора; |
| procedure Range(Index1, Index2: Integer); dynamic; | диапазон (часть массива); |
| function ReadList(FileName: String): TIntList; | чтение из файла; |
| procedure SortUp; virtual; | сортировка по неубыванию/возрастанию; |
| procedure SortDown; virtual; | сортировка по невозрастанию/убыванию; |
| function Sum: Integer; virtual; | сумма элементов; |
| procedure Trunc(Count: Integer); | обрезка; |
| procedure Turn; virtual; | разворот массива; |
| procedure Write(FileName: String); | запись в файл. |
|
Несколько примеров использования класса для var q, w: TIntList; s: String; j1, j2: Integer.
q.Assign([3,4,44,3,4,6,4,8,1,3,4,5,3,4]);
w.Assign([3,4]);
s := q.IndexesOf(w).AsString; | Список индексов q, начиная с которых найден w.
Вернёт s = '0 3 9 12'. |
q.Assign([73,4,44,3,4,6,4,8,1,3,4,5,3,4]);
s := q.Trunc(5).SortUpList.TurnList.AsString; | Обрезает q до 5 элементов, сортирует, разворачивает.
Вернёт s = '73 44 4 4 3'. |
q.Assign([1,1,1,1,1,1,1,1]); w.Assign([1,1,1]);
j1 := q.IntCount(w); j2 := q.IntCount2(w); | Вернёт j1 = 6 (всего вхождений w в q), j2 = 2
(непересекающихся вхождений w в q). |
s:= 'q+345sd6345 877 wrt 235 656-655+45er-9';
q.Assign([1001,1002]);
s := q.AddList(s).AsString; | Добавляет к списку константы, извлеченные из строки.
Вернёт s = '1001 1002 345 6345 877 235 656 -655 45 -9'. |
q.Assign([44,1,4,6,7,8,1,3,1,5,6]);
s:= q.CompressList.AsString; | Строка элементов сжатого массива.
Вернёт s = '44 1 4 6 7 8 3 5'. Сам q не изменится. |
q.Assign([1,4,5,3,1,8,4,5,3,3,1,3,4,5,3,3]);
ss:= q.ChangeList([4,5,3],[98,99]).AsString; | Замена фрагмента [4,5,3] на [98,99].
Вернёт '1 98 99 1 8 98 99 3 1 3 98 99 3'. |
|
Пример практического использования списка 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).
К материалу прилагаются файлы:
[Списки, коллекции] [Целые числа]
 Обсуждение материала [ 13-05-2009 03:46 ] 7 сообщений |
