Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 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.003 c
1-1253695891
Игорь
2009-09-23 12:51
2011.05.08
Как правильно передать из DLL?


3-1257918283
Alshtam
2009-11-11 08:44
2011.05.08
Сравнение баз данных


15-1295645386
Юрий
2011-01-22 00:29
2011.05.08
С днем рождения ! 22 января 2011 суббота


2-1296648381
NieL
2011-02-02 15:06
2011.05.08
Сформировать список


2-1296592407
Тимоха111
2011-02-01 23:33
2011.05.08
ошибка AV при получении динамического массива из длл





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский