Форум: "Основная";
Текущий архив: 2011.05.08;
Скачать: [xml.tar.bz2];
ВнизУдаление строк-дубликатов в Tmemo - более быстрый способ Найти похожие ветки
← →
nes © (2009-09-23 18:55) [0]Есть ли более быстрый способ удаления дубликатов,нежели
такой перебор
(в 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с ожидания
← →
Leonid Troyanovsky © (2009-09-23 19:05) [1]
> nes © (23.09.09 18:55)
> при небольшом кол-ве строк всё шоколадно) при 4-5к - 4-
> 7с ожидания
Для TMemo, AFAIK, трудно придумать что-то быстрое.
Если, конечно, не шаманить с EM_GETHANDLE&etc.
Для контролов with virtual (owner draw) styles можно предложить
брать в основу TStringList.
--
Regards, LVT.
← →
Сергей М. © (2009-09-23 19:42) [2]Через промежуточный TStringList
← →
nes © (2009-09-23 20:03) [3]пардон, поспешил в первом посте
список из 3-4к строк обрабатывается за 5-6 секунд - это при удалении дубликатов в Tstringlist и добавлении в новый Tstringlist
с мемо,такая операция занимает 30+++ секунд)
есть ли вариант более быстрого поиска и удаления дубликатов для Tstringlist,где прорисовка не требуется
← →
Сергей М. © (2009-09-23 20:26) [4]TStringList наделен функциональностью НЕдобавления дубликатов.
Этого достаточно для решения задачи.
← →
TIF © (2009-09-23 22:34) [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-ом выкинул, если надо - добавляем-с сами, я не против, я только саму суть раскрыл... :)
Меня способ устраивает, сколько-то там тысяч значений проверяется за несколько минут. Правда у меня и процессор четырёхядерный, так что результат может быть не такой оптимистичный ;-)
← →
atruhin © (2009-09-24 17:04) [6]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;
сортируем и линейно выкидываем лишнее, затем формируем текст из нужных строк.
← →
nes © (2009-09-24 19:12) [7]
> 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 20:52) [8]> То что нужно) менее секунды на 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;
← →
atruhin © (2009-09-24 21:02) [9]Вариант, если нужно сохранить порядок строк, если порядок не важен, можно упростить в пару раз.
На малых объемах скорость как у вставки в 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 раз.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2011.05.08;
Скачать: [xml.tar.bz2];
Память: 0.48 MB
Время: 0.004 c