Оригинальный заголовок: passing dynamic array of record to mergesort in Delphi
Описание проблемы (вопрос):
Мне нужно отсортировать динамический массив записей по полю типа boolean. Я передаю массив в функцию сортировки (merge-sort) и пытаюсь установить значение этого поля в TRUE, но, похоже, это не работает.
Я уже пытался решить эту проблему, изучив другие методы сортировки массива записей (например, quicksort для массива настраиваемых записей), но не смог применить ни один из этих подходов из-за создания функции сравнения. Этот вопрос был полезен и работает, но эта сортировка очень медленная.
Код:
type
TCustomRecord = record
fLine: AnsiString; // полная строка
fsubLine: AnsiString; // часть строки
isDuplicate: boolean; // является ли эта подстрока дубликатом в другой строке
isRefrence: boolean; // является ли эта строка из файла ссылки или той, которую нужно удалить дубликаты
fIndex: Cardinal; // исходный порядковый номер строки
end;
TCustomRecordArray = array of TCustomRecord;
PCustomRecord = ^TCustomRecord;
function Merge2(var Vals: array of TCustomRecord): Integer;
var
AVals: array of TCustomRecord;
// функция возвращает индекс последнего действительного элемента
function Merge(I0, I1, J0, J1: Integer): Integer;
var
i, j, k, LC: Integer;
begin
LC := I1 - I0;
for i := 0 to LC do
AVals[i] := Vals[i + I0];
// копирование нижней половины Vals в временный массив AVals
k := I0;
i := 0;
j := J0;
while ((i <= LC) and (j <= J1)) do
begin
if (AVals[i].fsubLine < Vals[j].fsubLine) then
begin
Vals[k] := AVals[i];
if Vals[k].isRefrence = False then
Vals[k].isDuplicate := False;
inc(i);
inc(k);
end
else if (AVals[i].fsubLine > Vals[j].fsubLine) then
begin
Vals[k] := Vals[j];
if Vals[k].isRefrence = False then
Vals[k].isDuplicate := False;
inc(k);
inc(j);
end
else
begin // дубликат
Vals[k] := AVals[i];
if Vals[k].isRefrence = False then
Vals[k].isDuplicate := True;
inc(i);
inc(j);
inc(k);
end;
end;
// копирование остатка
while i <= LC do
begin
Vals[k] := AVals[i];
inc(i);
inc(k);
end;
if k <> j then
while j <= J1 do
begin
Vals[k] := Vals[j];
inc(k);
inc(j);
end;
Result := k - 1;
end;
// функция возвращает индекс последнего действительного элемента
function PerformMergeSort(ALo, AHi: Integer): Integer;
var
AMid, I1, J1: Integer;
begin
// лучше использовать Insertion Sort, когда (AHi - ALo) мало (примерно 32-100)
if (ALo < AHi) then
begin
AMid := (ALo + AHi) shr 1;
I1 := PerformMergeSort(ALo, AMid);
J1 := PerformMergeSort(AMid + 1, AHi);
Result := Merge(ALo, I1, AMid + 1, J1);
end
else
Result := ALo;
end;
begin
//SetLength(AVals, Length(Vals) + 1 div 2);
SetLength(AVals, Length(Vals) div 2 + 1);
Result := 1 + PerformMergeSort(0, High(Vals));
end;
Вопрос: Как мне эффективно отсортировать этот массив записей, предпочтительно используя merge-sort, и установить значение поля isDuplicate в соответствии с этим?
Обновление: Я добавил тип указателя и выполнил модифицированный merge-sort для массива указателей. Это оказалось очень быстрым способом сортировки массива записей. Я также добавил функцию сравнения, которая добавляла флаги, которые мне были нужны. Единственная часть, которую я не смог сделать, - это добавить флаг для дубликатов на основе того, принадлежат они файлу A или файлу ссылки.
Код:
type
PCustomRecord = ^TCustomRecord;
TCustomRecord = record
fLine: AnsiString; // полная строка
fsubLine: AnsiString; // часть строки
isDuplicate: boolean; // является ли эта подстрока дубликатом в другой строке
isRefrence: boolean; // является ли эта строка из файла ссылки или той, которую нужно удалить дубликаты
isUnique: boolean; // флаг для установки, если не ссылка и не дубликат
fIndex: Cardinal; // исходный порядковый номер строки
end;
TCustomRecordArray = array of TCustomRecord;
PCustomRecordList = ^TCustomRecordArray;
// установить фактический массив
// установить массив указателей, указывающих на фактический массив
// отсортировать с помощью merge-sort сперва
// затем вызвать функцию сравнения - это может быть процедура
function Compare(var PRecords: array of PCustomRecord; iLength: int64): Integer;
var
i: Integer;
begin
for i := 0 to High(PRecords) do
begin
Result := AnsiCompareStr(PRecords[i]^.fsubline, PRecords[i + 1]^.fsubline);
if Result = 0 then
begin
if (PRecords[i].isRefrence = False) then
PRecords[i].isDuplicate := True
else if (PRecords[i + 1].isRefrence = False) then
PRecords[i + 1].isDuplicate := True;
end;
end;
end;
procedure MergeSort(var Vals: array of PCustomRecord; ACount: Integer);
var
AVals: array of PCustomRecord;
procedure Merge(ALo, AMid, AHi: Integer);
var
i, j, k, m: Integer;
begin
i := 0;
for j := ALo to AMid do
begin
AVals[i] := Vals[j];
inc(i);
// копирование нижней половины Vals в временный массив AVals
end;
i := 0; j := AMid + 1; k := ALo; // j может быть неопределенным после цикла for!
while ((k < j) and (j <= AHi)) do
if (AVals[i].fsubline <= Vals[j].fsubline) then
begin
Vals[k] := AVals[i];
inc(i); inc(k);
end
else if (AVals[i].fsubline > Vals[j].fsubline) then
begin
Vals[k] := Vals[j];
inc(k); inc(j);
end;
else
begin // дубликат
Vals[k] := AVals[i];
inc(i); inc(j); inc(k);
end;
// найти следующее большее значение в Vals или AVals и скопировать его в правильное место.
for m := k to j - 1 do
begin
Vals[m] := AVals[i];
inc(i);
end;
// скопировать остаток неотсортированных элементов
end;
procedure PerformMergeSort(ALo, AHi: Integer);
var
AMid: Integer;
begin
if (ALo < AHi) then
begin
AMid := (ALo + AHi) shr 1;
PerformMergeSort(ALo, AMid);
PerformMergeSort(AMid + 1, AHi);
Merge(ALo, AMid, AHi);
end;
end;
begin
SetLength(AVals, ACount div 2 + 1);
PerformMergeSort(0, ACount - 1);
end;
Этот подход очень быстрый на небольших файлах, занимает меньше секунды. Удаление дубликатов элементов в массиве, которые несут флаг дубликата и НЕ являются файлом ссылки, является сложной задачей. Как стабильная сортировка, я пытался отсортировать по флагу boolean, но не получил ожидаемых результатов. Я использовал TStringList для просмотра того, правильно ли устанавливаются предыдущие флаги, и это работает идеально. Время возросло с 1 секунды до 6 секунд. Я знаю, что должен быть простой способ установить флаг isUnique без использования TStringList.
Вопрос: Помогите мне создать функцию или процедуру для установки флагов дубликата для повторяющихся элементов с isRefrence = False и isDuplicate = True и isUnique.
Примечание: Я уже знаю, как получить TObject и как использовать TStringList, поэтому прошу не сосредоточиваться на этих темах. Фокус должен быть на массивах.
Ответ:
Проблема заключается в том, что автор пытается изменить значение поля isDuplicate в процессе сортировки, что приводит к неожиданным результатам. Чтобы решить эту проблему, можно отделить процесс сортировки от процесса изменения полей записей. Вот как это можно сделать:
Создайте функцию сравнения, которая будет сравнивать записи по полю fsubLine. Эта функция не будет ничего менять в записях.
Создайте процедуру, которая будет менять значение поля isDuplicate в записях на основе результатов сравнения. Эта процедура не будет ничего сортировать.
Используйте функцию сравнения и процедуру изменения в функции сортировки (например, merge-sort).
Вот пример кода, который демонстрирует этот подход:
type
TCustomRecord = record
fLine: AnsiString;
fsubLine: AnsiString;
isDuplicate: boolean;
isRefrence: boolean;
fIndex: Cardinal;
end;
TCustomRecordArray = array of TCustomRecord;
PCustomRecord = ^TCustomRecord;
function CompareSubstrings(Item1, Item2: PCustomRecord): Integer;
begin
Result := AnsiCompareStr(Item1^.fsubLine, Item2^.fsubLine);
end;
procedure SetDuplicateFlags(var PRecords: array of PCustomRecord; iLength: int64);
var
i: Integer;
begin
for i := 0 to High(PRecords) do
begin
if (PRecords[i].isRefrence = False) and (PRecords[i + 1].isRefrence = False) then
begin
if CompareSubstrings(PRecords[i], PRecords[i + 1]) = 0 then
PRecords[i].isDuplicate := True;
end;
end;
end;
procedure MergeSort(var Vals: array of PCustomRecord; ACount: Integer);
var
AVals: array of PCustomRecord;
procedure Merge(ALo, AMid, AHi: Integer);
var
i, j, k, m: Integer;
begin
// ... (код функции Merge, как в примере из вопроса)
end;
procedure PerformMergeSort(ALo, AHi: Integer);
var
AMid: Integer;
begin
if (ALo < AHi) then
begin
AMid := (ALo + AHi) shr 1;
PerformMergeSort(ALo, AMid);
PerformMergeSort(AMid + 1, AHi);
Merge(ALo, AMid, AHi);
SetDuplicateFlags(Vals, AHi - ALo + 1);
end;
end;
begin
SetLength(AVals, ACount div 2 + 1);
PerformMergeSort(0, ACount - 1);
end;
В этой версии кода функция SetDuplicateFlags устанавливает флаг isDuplicate для записей, у которых поле fsubLine имеет одинаковое значение, и только для тех записей, которые не являются файлами ссылками. Функция MergeSort сортирует записи с помощью merge-sort, а затем вызывает SetDuplicateFlags для установки флагов дубликатов. Это разделение процесса сортировки и процесса изменения полей записей позволяет добиться правильного результата.
Пользователь хочет отсортировать динамический массив записей по полю типа boolean и установить значение этого поля в TRUE в процессе сортировки с помощью merge-sort в Delphi. Однако, у пользователя возникают проблемы с правильной установкой значения поля
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Telegram-канал