Promazani dvou Memo s hodne daty – Delphi – Fórum – Programujte.com
 x   TIP: Přetáhni ikonu na hlavní panel pro připnutí webu
Reklama
Reklama

Promazani dvou Memo s hodne daty – Delphi – Fórum – Programujte.comPromazani dvou Memo s hodne daty – Delphi – Fórum – Programujte.com

 

Hledá se programátor! Plat 1 800 € + bonusy (firma Boxmol.com)
dyžon0
Stálý člen
1. 4. 2013   #1
-
0
-

Cau lidi,

potrebuju promazat dve Mema se spoustou radku.
napsal jse na to tohle, ale neni to dobry,  Memo1 ma zhruba 50K radku a Memo2 asi 14K  a trva to strasne dlouho, kolem 20 hodin, nedalo by se to napsat nejak,aby to bylo rychlejsi ??

function zjisti(radek: string): integer;
var b: integer;
begin
 For b:= 0 to Form1.Memo1.Lines.Count-1 do
  begin
    If Form1.Memo1.Lines[b] = radek then
      begin
      Form1.Memo1.Lines.Delete(b);
      result:= 1;
      end;
  end;
  result:= 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var a,c: integer;
begin
  c:= 0;
  For a:= 0 to Memo2.Lines.Count-1 do
  begin
  c:= c + Zjisti(Memo2.Lines[a]);
  end;
  Label1.caption:= ('Odstraneno '+ IntToStr(c)+' zaznamu.');
end;

pokud mate nejakej napad, prosim poradte, dekuju.

Nahlásit jako SPAM
IP: 89.102.38.–
Reklama
Reklama
dyžon0
Stálý člen
1. 4. 2013   #2
-
0
-

ve skutecnosti to pocitani zaznamu by melo byt v te funkci, v Memo1 se radky muzou opakovat,
ale to je nepodstatny, problem je v tom case.
 

Nahlásit jako SPAM
IP: 89.102.38.–
KIIV+42
God of flame
1. 4. 2013   #3
-
0
-

podle me by bylo rychlejsi mit dalsi objekt lines, kam bys zkopiroval co se nema odstranit a pak tim prepsat puvodni memo

Nahlásit jako SPAM
IP: 94.113.92.–
Program vždy dělá to co naprogramujete, ne to co chcete...
zlz
~ Anonymní uživatel
634 příspěvků
1. 4. 2013   #4
-
0
-

Nevím, jak je implementovaný ten objekt Lines, ale pokud není úplně dementní, tak zbytečné zpomalení navíc asi udělá hlavně překreslování toho Mema. To by snad mělo jít potlačit přidáním Lines.BeginUpdate a EndUpdate kolem toho cyklu.

Nahlásit jako SPAM
IP: 80.188.216.–
Sniper
~ Anonymní uživatel
184 příspěvků
2. 4. 2013   #5
-
0
-

Předně, když v seznamu něco mažeš, tak ho procházej odzadu, jinak tě očekávají problémy.
S použitím prostředníka (dočasný seznam kam předávám to, co nemá být smazáno - jak píše KIIV) a hashování jsem se dostal na 5,1s pro porovnání a promazání 50k/14k záznamů (pseudonáhodné stringy o délce 20 - 50 znaků). Nevím, jaká máš vstupní data, ale řekl bych, že taková rychlost je dostatečná, takže tam bych to směřoval.
Nejsem si ale 100% jistý, čeho přesně chceš dosáhnout (podle kódu to vypadá, že z Memo1 chceš vymazat řádky, které se nachází i v Memo2), takže zatím nebudu postovat kód.

Nahlásit jako SPAM
IP: 90.179.201.–
dyžon0
Stálý člen
2. 4. 2013   #6
-
0
-

Dekuji za prispevky,

ano, je to tak, ze chci vymazat z Memo1 vsechny shodne zaznamy z Memo2.
jestli jsem to spravne pochopil, tak bych mel prohledavat Memo2 radkama z Memo1 a vytvorit treba StringList,kterej bych plnil vsema zaznamama,ktery se neshodujou a tim potom prepsal Memo1.
Akorat nevim u ceho pouzit BeginUpdate a EndUpdate ..
a tim odzadu myslis: 

For a:= Memo1.Lines.Count-1 downto 0 do

??

Nahlásit jako SPAM
IP: 94.113.28.–
KIIV+42
God of flame
2. 4. 2013   #7
-
0
-

tak ono od zadu to pomuze jen trosku... (hodne pokud by se odmazavalo prakticky vse)

kazdopadne to ma hned nekolik tezkejch zadrhelu... uz jen to prohledavani jestli jsou jednotlive radky tam je docela narocny... lepsi by bylo spocitat si hashe... nebo aspon mit to druhe v binarnim stromu

pak samozrejme pokud se odmazava od prvniho radku k poslednimu, tak po kazdem odmazani se celej zbytek pameti posouva, prepocitavaji se lines a tak dale

proste slozitost je naprosto brutalni...

a ty updaty by mely zastavit prekreslovani a na konci se pak prekresli jen konecny vysledek... tj. by to melo patrit k tomu co menis a nechces prekreslovat s kazdym odmazanim radku

Nahlásit jako SPAM
IP: 62.168.56.–
Program vždy dělá to co naprogramujete, ne to co chcete...
Sniper
~ Anonymní uživatel
184 příspěvků
2. 4. 2013   #8
-
0
-

 Takhle nějak jsem to spíchnul:

{$DEFINE def_FullCompare}

Function DeleteItems(Source, Compare: TMemo): Integer;
var
  i:              Integer;
  TempList:       TStringList;
  CompHashArray:  Array of LongWord;

  Function IsInCompare(const Line: String): Boolean;
  var
    ii:         Integer;
    LineCRC32:  LongWord;
  begin
    Result := False;
    LineCRC32 := CRC32(Line);
    For ii := Low(CompHashArray) to High(CompHashArray) do
      If LineCRC32 = CompHashArray[ii] then
    {$IFDEF def_FullCompare}
        If AnsiSameStr(Line,Compare.Lines[ii]) then
    {$ENDIF}
        begin
          Result := True;
          Break;
        end;
  end;

begin
Result := 0;
If Assigned(Source) and Assigned(Compare) then
  begin
    TempList := TStringList.Create;
    try
      SetLength(CompHashArray,Compare.Lines.Count);
      For i := 0 to (Compare.Lines.Count - 1) do
        CompHashArray[i] := CRC32(Compare.Lines[i]);
      For i := 0 to (Source.Lines.Count - 1) do
        If IsInCompare(Source.Lines[i]) then Inc(Result)
          else TempList.Add(Source.Lines[i]);
      Source.Lines.Assign(TempList);
    finally
      TempList.Free;
    end;
  end;
end;

CRC32 je ze synapse, asi by se dalo použít něco jinýho, ale tohle bylo při ruce. Dalo by se to nejspíš napsat líp, tak pokud máte někdo připomínky nebo postřehy, rád se přiučím. Jináč s tím procházením od konce jsem nemyslel kvůli rychlosti, ale protože při procházení cyklem FOR a při mazání takhle několik položek přeskočí (ty, co se "sesunou" na místo aktuálně vymazané) a na konci bude přistupovat k položkám které už neexistují.

Nahlásit jako SPAM
IP: 90.179.201.–
dyžon0
Stálý člen
2. 4. 2013   #9
-
0
-

Tak nevim, ..
udelal jsem,ze jsem Mema nahradil ListBoxama a pred prohledavanim jsem jjejich obsah prevedl do StringListu.
potom do SL3 vkladam radky,ktery nejsou shodny. viz:

function zjisti(radek: string): integer;
var e: integer;
begin
  For e:= 0 to Form1.SL2.Count-1 do
    begin
    If Form1.SL2[e] = radek then
      begin
      result:= 0;
      end else
     // Form1.SL3.BeginUpdate;
      Form1.SL3.Add(radek);
     // Form1.SL3.EndUpdate;
      result:= 1;
      end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var a,b: integer;
begin
  b:=0;
  SL1.Assign(ListBox1.Items);
  SL2.Assign(ListBox2.Items);
  For a:= 0 to SL1.Count-1 do
    begin
    Label3.Caption:= SL1[a];
    Application.ProcessMessages;
    b:= b+ Zjisti(SL1[a]);
    Label4.Caption:= IntToSTr(b);
    end;
  ListBox3.Assign(SL3);
  Label5.Caption:= IntToStr(ListBox3.Count);
  ShowMessage('hotovo!!');
end;

s tim BeginUpdate a EndUpdate jsem to asi uplne nepochopil.
vyrazne se to zrychlilo a tohle by mi i stacilo, ale pri zhruba 4500 radku to vyhodi hlasku OutOfMemory ... 
da se nejak ta pamet cistit ??   rikal jsem si treba po kazdym prohlidlym radku SL1 napsat SL1.free, ale to je hrozna blbost, uprostred cyklu to nejde ...

To: Sniper ...  mohl bych te poprosit, jestli by jsi ten kod postnul, podival bych se ,co tam mas jinak a urcite lip ..
 dekuji

Nahlásit jako SPAM
IP: 89.102.38.–
dyžon0
Stálý člen
2. 4. 2013   #10
-
0
-

#8 Sniper
dekuju, tohle na me vypada dost slozite,ale zkusim se v tom pohrabat.

Nahlásit jako SPAM
IP: 89.102.38.–
Sniper
~ Anonymní uživatel
184 příspěvků
2. 4. 2013   #11
-
0
-

Co konkrétně ti není jasné?

Nahlásit jako SPAM
IP: 90.179.201.–
dyžon0
Stálý člen
2. 4. 2013   #12
-
0
-

#11 Sniper
no celkem jsem to uz pochopil, ale kdyz to dam prelozit, tak mi pise, ze neni deklarovany CRC32, tak jsem vlezl na google, a po chvilce stahl  CRC32.pas, jenze kdyz ho dam Components/InstalComponents, tak mi zase pise, ze nenasel TntUnicodeVcl_R70; ..  tak jeste zkusim hledat tohle, treba se nakonec zadari a budu moct zkouset ..
jinak uz se v tom zacinam vyznavat, na prvni pohled mi to prislo slozity, ale druhym pohledem je to celkem prehledny ..  dekuju jeste jednou .
 

Nahlásit jako SPAM
IP: 89.102.38.–
Sniper
~ Anonymní uživatel
184 příspěvků
2. 4. 2013   #13
-
0
-

Jak jsem psal, ta funkce CRC32 je ze synapse, konkrétně unita synacode. Ale v podstatě půjde použít cokoliv, co spočítá CRC stringu (možná bude třeba změnit název volané funkce).

Nahlásit jako SPAM
IP: 90.179.201.–
dyžon0
Stálý člen
2. 4. 2013   #14
-
0
-

vim, ze se ptam jak hlupak, ale ze je ze synapse znamena, ze co mam pridat do uses ??

Nahlásit jako SPAM
IP: 89.102.38.–
Sniper
~ Anonymní uživatel
184 příspěvků
2. 4. 2013   #15
-
0
-
Nahlásit jako SPAM
IP: 90.179.201.–
dyžon0
Stálý člen
2. 4. 2013   #16
-
0
-

tak uz mi to jede, dekuju moc ...  zase umim neco novyho ..

Nahlásit jako SPAM
IP: 89.102.38.–
dyžon0
Stálý člen
2. 4. 2013   #17
-
0
-

tak zatim nevim proc, ale vcera jsem pres den a noc nechal pustenej ten muj strasnej pomalej kod a dneska jsem zkusil ten superrychlej tvuj kod a je mezi tim rozdil nejakych 26 radku ..   tem muj jich smazal vic, ale mam to ulozeny, tak projdu ktery to jsou a zkusim najit proc.

Nahlásit jako SPAM
IP: 89.102.38.–
Sniper
~ Anonymní uživatel
184 příspěvků
2. 4. 2013   #18
-
0
-

Máš nějakej vzorek dat, že bych se na to kouknul?

Nahlásit jako SPAM
IP: 90.179.201.–
Michal
~ Anonymní uživatel
624 příspěvků
10. 4. 2013   #19
-
0
-

Když koukám na vaše zdrojové kódy, zdá se mi, že jste zapoměli na funkci IndexOf.  Já osobně bych řešení problematiky implementoval následujícím způsobem, kde testovací data byla následující: seznam ve kterém se hledalo a mazalo měl 60K řádku, a druhý seznam měl 6K řádků. Výsledný čas byl 1:50 [min:sec]. 

procedure DeleteMatch(var lWhere: TStringList; const lProhibited: TStringList);
var
  I: Integer;
  iLine: Integer;
begin
  // Your prohibited list
  for I := 0 to lProhibited.Count - 1 do
  begin
    iLine := lWhere.IndexOf(lProhibited[I]);
    // Find all matches, if there is duplicite item
    while iLine <> -1 do
    begin
      lWhere.Delete(iLine);
      iLine := lWhere.IndexOf(lProhibited[I]);
    end;
  end;
end;
Nahlásit jako SPAM
IP: 62.240.183.–
Michal
~ Anonymní uživatel
624 příspěvků
10. 4. 2013   #20
-
0
-

jinak největší zabiják je samozřejmě "softwarová" grafika - překreslení TLabel, překreslení TListBox, ... další věc, kterou bych podotknul je, že Application.ProccessMessage je také velice časově náročná záležitost a navíc ani nemáš možnost zjistit, jak dlouho se vlastně ztrácí na App.ProcMsg, páč je to předání řízení Windowsům, a ty si udělají svou operaci a pak zase dají řízení tvému programu, tudíž bych ani tento krok nezahrnoval do zdrojáku.

PS pokud chceš mermomocí vidět jak droják pokračuje, kde se zrovna nachází místo toho aby jsi překresloval label v každé iteraci použij například toto:

{Jednou za 500 iterací překresli komponentu.
  
Je mnohem^2 rychlejší vypočítat matematickou úlohu tohoto typu než překresli     komponentu.}

if i mod 500 = 0 then
begin
  repaint ...
  app.procMsg
end; 

A jinak jak jsis mohl všimnout, uživatel Sniper používal vnořené funkce ... to je taky dobrý krok ke zrychlení, to je ale dáno překladem do assembleru a to asi nestojí za vysvětlování v tomto příspěvku :)

Nahlásit jako SPAM
IP: 62.240.183.–
dyžon0
Stálý člen
11. 4. 2013   #21
-
0
-

super, dekuju, za dalsi moznosti,

na vterinach mi nezalezi, ale skoro 20 hodin je fakt moc :o))
je dobre znat i dalsi zpusoby reseni, takze dekuju.

To Sniper: ...  bohuzel vzorek ti dat nemuzu, jsou to interni data nasi firmy a nemam dovoleno je sirit, takze se omlouvam.

To Michal: ... jasny, vnoreni funkce jsem si vsiml jako prvniho, nikdy jsem nepouzil do te doby, ted uz pouzivam skoro vsude ,kde to jde.

Nahlásit jako SPAM
IP: 94.113.28.–
Zjistit počet nových příspěvků

Přidej příspěvek

Toto téma je starší jak čtvrt roku – přidej svůj příspěvek jen tehdy, máš-li k tématu opravdu co říct!

Ano, opravdu chci reagovat → zobrazí formulář pro přidání příspěvku

×Vložení zdrojáku

×Vložení obrázku

Vložit URL obrázku Vybrat obrázek na disku
Vlož URL adresu obrázku:
Klikni a vyber obrázek z počítače:

×Vložení videa

Aktuálně jsou podporována videa ze serverů YouTube, Vimeo a Dailymotion.
×
 
Podporujeme Gravatara.
Zadej URL adresu Avatara (40 x 40 px) nebo emailovou adresu pro použití Gravatara.
Email nikam neukládáme, po získání Gravatara je zahozen.
-
Pravidla pro psaní příspěvků, používej diakritiku. ENTER pro nový odstavec, SHIFT + ENTER pro nový řádek.
Sledovat nové příspěvky (pouze pro přihlášené)
Sleduj vlákno a v případě přidání nového příspěvku o tom budeš vědět mezi prvními.
Reaguješ na příspěvek:

Uživatelé prohlížející si toto vlákno

Uživatelé on-line: 0 registrovaných, 18 hostů

Podobná vlákna

Memo — založil infomf

Memo — založil 12345p

Hodne Velkej Help !!!! — založil Zbyněk Juroš

 

Hostujeme u Českého hostingu       ISSN 1801-1586       ⇡ Nahoru Webtea.cz logo © 20032016 Programujte.com
Zasadilo a pěstuje Webtea.cz, šéfredaktor Lukáš Churý