Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Удаление строк-дубликатов в Tmemo - более быстрый способ [D7, WinXP]

nes © (2009-09-23 18:55:00)
Есть ли более быстрый способ удаления дубликатов,нежели
такой перебор

(в memo2 уже без дубликатов)

var
a,b:integer;
con:boolean;
begin
for a:=0 to memo1.Lines.Count-1 do
begin
con:=false;
for b:=0 to memo2.lines.count-1 do
begin
if memo1.lines.Strings[a]=memo2.Lines.Strings[b] then con:=true;
end;
if not con then memo2.Lines.Add(memo1.lines.Strings[a]);
end;
end;

при небольшом кол-ве строк всё шоколадно) при 4-5к - 4-7с ожидания

atruhin (2009-09-24 21:02:00) [1]
Вариант, если нужно сохранить порядок строк, если порядок не важен, можно упростить в пару раз.
На малых объемах скорость как у вставки в TStringList, если же объем приличный то:
мой вариант:
Time : 13182 ms
Count line before : 505000
Count line after : 499999
[OK]
вставка в TStringList:
Time : 171648 ms
Count line before : 505000
Count line after : 499999
[OK]
т.е. быстрее в 13 раз.

atruhin (2009-09-24 20:52:00) [2]
> То что нужно) менее секунды на 3-4к строк
>
> Всем спасибо! с меня пиво))

;) Только что проверил, менее секунды на 50000 строк. На довольно среднем компе.

const
LineBreak = #13#10;
type
THackStringList = class(TStringList);

procedure TForm1.Button1Click(Sender: TObject);
var
StartTime, EndTime : DWORD;
St : array [0..80] of THackStringList;
StartCnt, EndCnt, Idx, Fnd, LenOut, CntHash : integer;
Text, TextOut, Line : string;
P, Start : PChar;
begin
StartCnt := Memo1.Lines.Count;
EndCnt := 0; CntHash := 0;
FillChar(St[0], SizeOf(Pointer) * Length(St), 0);
StartTime := GetTickCount;
Text := Memo1.Lines.Text;
SetLength(TextOut, Length(Text));
LenOut := 0;
P := Pointer(Text);
while P^ <> #0 do begin
Start := P;
while not (P^ in [ #0, #10, #13]) do Inc(P);
SetString(Line, Start, P - Start);
if Length(Line) > 2
then Idx := (Ord(Line[1]) + Ord(Line[2])) mod Length(St)
else Idx := 0;
if not Assigned(St[Idx]) then begin
St[Idx] := THackStringList.Create;
St[Idx].Capacity := 150;
St[Idx].Sorted := true;
inc(CntHash);
end;
if not St[Idx].Find(Line, Fnd) then begin
St[Idx].InsertItem(Fnd, Line, nil); {}
Move(Line[1], TextOut[LenOut + 1], Length(Line));
inc(LenOut, Length(Line) + Length(LineBreak));
TextOut[LenOut - 1] := #13;
TextOut[LenOut] := #10;
inc(EndCnt);
end;
if P^ = #13 then Inc(P);
if P^ = #10 then Inc(P);
end;
Memo1.Lines.Text := TextOut;
EndTime := GetTickCount;
ShowMessage('Time : ' + inttostr(EndTime - StartTime) + ' ms'#13#10 +
'Count line before : ' + IntToStr(StartCnt) + #13#10 +
'Count line after : ' + IntToStr(EndCnt) + #13#10 +
'Hash count : ' + IntToStr(CntHash));
end;

nes (2009-09-24 19:12:00) [3]

> atruhin © (24.09.09 17:04) [6]
>
> 1. Читать не по 1 строке а полностью, т.е.
> S1 := memo1.Lines.Text;
> S2 := memo1.Lines.Text;
> // Сравниваем.
> memo1.Lines.Text := S1;
> memo1.Lines.Text := S2;

не понял как происходит сравнение в данном случае

> TIF © (23.09.09 22:34) [5]
>
>
> Я избавляюсь от дублей с помощью двух TStringList-ов. Ключевой
> момент кода:
> for i:=0 to SL1.Count-1
> do
> begin
> if SL2.IndexOf(SL1.Items[i])=-1
> then SL2.Add(SL1.Items[i]);
> end;

по времени занимает также,как и способ в топике-недостаточно быстро

> Сергей М. © (23.09.09 20:26) [4]
>
> TStringList наделен функциональностью НЕдобавления дубликатов.
>
> Этого достаточно для решения задачи.

То что нужно) менее секунды на 3-4к строк

Всем спасибо! с меня пиво))

atruhin (2009-09-24 17:04:00) [4]
1. Читать не по 1 строке а полностью, т.е.
S1 := memo1.Lines.Text;
S2 := memo1.Lines.Text;
// Сравниваем.
memo1.Lines.Text := S1;
memo1.Lines.Text := S2;
2. Можно рассмотреть вариант с подсчетом хэша строки, т.е. составляем 2 массива хэшей,
array of record record
Hash : ...;
NumStr : integer;
end;
сортируем и линейно выкидываем лишнее, затем формируем текст из нужных строк.

TIF (2009-09-23 22:34:00) [5]
> где прорисовка не требуется

Прорисовкуна время работы нужно отключать(если работаем с визуальным компонентом)...
BeginUpdate и EndUpdate

Я избавляюсь от дублей с помощью двух TStringList-ов. Ключевой момент кода:
for i:=0 to SL1.Count-1 do begin if SL2.IndexOf(SL1.Items[i])=-1 then SL2.Add(SL1.Items[i]); end;
(визуализацию ProgressBar-ом выкинул, если надо - добавляем-с сами, я не против, я только саму суть раскрыл... :)

Меня способ устраивает, сколько-то там тысяч значений проверяется за несколько минут. Правда у меня и процессор четырёхядерный, так что результат может быть не такой оптимистичный ;-)

Сергей М. (2009-09-23 20:26:00) [6]
TStringList наделен функциональностью НЕдобавления дубликатов.
Этого достаточно для решения задачи.

nes (2009-09-23 20:03:00) [7]
пардон, поспешил в первом посте

список из 3-4к строк обрабатывается за 5-6 секунд - это при удалении дубликатов в Tstringlist и добавлении в новый Tstringlist

с мемо,такая операция занимает 30+++ секунд)

есть ли вариант более быстрого поиска и удаления дубликатов для Tstringlist,где прорисовка не требуется

Сергей М. (2009-09-23 19:42:00) [8]
Через промежуточный TStringList

Leonid Troyanovsky (2009-09-23 19:05:00) [9]

> nes © (23.09.09 18:55)

> при небольшом кол-ве строк всё шоколадно) при 4-5к - 4-
> 7с ожидания

Для TMemo, AFAIK, трудно придумать что-то быстрое.
Если, конечно, не шаманить с EM_GETHANDLE&etc.

Для контролов with virtual (owner draw) styles можно предложить
брать в основу TStringList.

--
Regards, LVT.

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »