Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2011.05.08;
Скачать: CL | DM;

Вниз

Удаление строк-дубликатов в 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;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.005 c
15-1296121492
Джек
2011-01-27 12:44
2011.05.08
Сайты


2-1296692040
antonn
2011-02-03 03:14
2011.05.08
отложенная загрузка картинки в THTMLViewer/ThtmlLite


2-1295949753
Тимоха111
2011-01-25 13:02
2011.05.08
Захват изображения части окна


15-1294777603
Verter_Alice
2011-01-11 23:26
2011.05.08
Метод слежки с помощью куков


2-1296232735
bagos
2011-01-28 19:38
2011.05.08
Передача данных между программами