Listedeki sayılardan yanyana aynı rakam içerenleri ayıklama

[karflake]

Merhaba.

Elimde aşağıdaki gibi sayılardan oluşan 123 mb'lık bir txt dosya var.

Kod: Tümünü seç

46000009346
46000009414
46000009582
46529897330
46359697408
46639597576

Bu bu txt dosyasında içindeki sayılardan, aynı rakamın yanyana 2 den fazla tekrar etmemiş olanları ayırmak istiyorum. Yani yukarıdaki listeden,

Kod: Tümünü seç

46359697408
46639597576

sayılarını ayırmak istiyorum. Bunu hızlı olarak nasıl yapabilirim?

[ulu coder]

Hızı ne olur bilmiyorum. Ama aklıma şu geldi

Bir döngü içine:

Kod: Tümünü seç

var
  i: Integer;
  bulundu: Boolean;
begin
  i := 0;
  Bulundu := False;
  Repeat
    bulundu := AnsiPos(inttostr(i)+inttostr(i),Satir)>0;
    inc(i)
  Until (i=10) or (Bulundu);
  if not(bulundu) then ...
end;

[Glen]

Bir baska alternatif

var
y, d : TstringList;
j, i : integer;
s : ansistring;
begin
d := TstringList.create;
y := TStringList.Create;
d.loadFromFile('dosya.txt');

For i := 0 to d.count -1 do
begin
s := d.strings;
For j := 1 to length(s) -3 do
begin
if (s[j] = s[j+1]) and (s[j] = s[j+2]) then
break;
y.add(s);
end;
end;

y.saveToFile('Cokuzattimgaliba.txt');
end;

[karflake]

Arkadaşlar öneriler için teşekkürler. Ben aşağıdaki yolu kullandım ama maalesef hızlı değil(2 karakterin de yanyana olmaması gerektiği fark ettiğim için sorduğumdan biraz farklı oldu).

Kod: Tümünü seç

function ayikla(metin: string): boolean;
var
  i: integer;
begin
  if (pos('00',metin)>0) or
     (pos('11',metin)>0) or
     (pos('22',metin)>0) or
     (pos('33',metin)>0) or
     (pos('44',metin)>0) or
     (pos('55',metin)>0) or
     (pos('66',metin)>0) or
     (pos('77',metin)>0) or
     (pos('88',metin)>0) or
     (pos('99',metin)>0) then
  begin
    result:=true;
    exit;
  end;
  result:=false;
end;

Daha hızlı bir önerisi olan var mı?

[poshet303]

pos la yapılan işlemler her halukarda yavaş olacaktır. Çünkü string içinde aynı arama işlemi defalarca tekrarlanıyor.

Kod: Tümünü seç

function ayikla(metin: string): boolean;
var
 i, lenx, countx: integer;
 charx:char;
begin
 result:=true;
 lenx:=Length(metin);
 charx:='?';
 countx:=0;
 for i:=1 to lenx do
 begin
  if countx>2 then begin
   result:=false;
   break;//exit;
  end;
  if metin[i]<>charx then begin
   charx:=metin[i];
   countx:=0;
  end else
   inc(countx);
 end;
end;

bu kodu bir deneyip aradaki hız farkını (dakika saniye cinsinden) geri bildirirmisin. Bende merak ettim. Sizin kod kaç saniyede bitiriyor benim yazdığım kod kaç saniyede bitiriyor?

[Z.D.]

delphinin inline assembler desteği var biliyosunuz, belki şöyle bir algoritma işinizi görebilir.

Kod: Tümünü seç

Procedure TForm1.Button1Click(Sender: TObject);
Var
  Buf_Urun, Buf_Hammadde: TStringList;
  Buff1, Buff2: AnsiString;
Begin
  Memo1.Lines.LoadFromFile('Dosya.txt');
  Buf_Hammadde := TStringList.Create;
  Buf_Urun := TStringList.Create;
  Buf_Hammadde.LoadFromFile('Dosya.txt');

  Buff1 := Buf_Hammadde.Text;
  Buff2 := Buf_Hammadde.Text;

  Asm
    pushad
    mov     esi, Buff1;
    mov     edi, Buff2;
    xor     ebx,ebx
    nop
    jmp     @Geri

@BuffUrun_Gerigel:
    dec    edi
    mov    al,byte ptr[edi]
    cmp    al,0
    je     @www
    cmp    al,10
    je     @www
    mov    byte ptr[edi],0
    jmp    @BuffUrun_Gerigel
@www:
    inc   edi
@AltSatira_Gec:
    mov   al,byte ptr[esi]
    inc   esi
    cmp   al,10
    jne   @AltSatira_Gec
@Geri:
    mov   al,byte ptr[esi]
    mov   [edi],al
    cmp   al,0
    jle   @Bitti
    inc   esi
    inc   edi
    cmp   al,byte ptr[esi]
    je    @BuffUrun_Gerigel
    nop
    jmp   @Geri
@Bitti:
    nop
    nop
    popad
  End;

  Buf_Urun.Text := Buff2;
  Buf_Urun.saveToFile('Sonuçlar.txt');
  Memo2.Lines.LoadFromFile('Sonuçlar.txt');
End;

Yüklenecek dosyayı program ile aynı dizinde oluşturun, "Dosya.txt". + Formda birtanede Memo nesnesi olsun, sonuçları görebilirsiniz. İşlem sonunda, sonuçları "Sonuçlar.txt" dosyasına kaydediyorum.

İyi çalışmalar

[karflake]

@poshet303 yanıtınız için teşekkür ederim.

Öncelikle vermiş olduğunuz kodu, benim program için aşağıdaki şekilde uyarladım:

Kod: Tümünü seç

function ayikla(metin: string): boolean;
var
 i, lenx, countx: integer;
 charx:char;
begin
 result:=false;
 //lenx:=Length(metin);
 charx:='?';
 countx:=0;
 for i:=1 to 11{lenx} do
 begin
  if countx=1 then begin
   result:=true;
   break;//exit;
  end;
  if metin[i]<>charx then begin
   charx:=metin[i];
   countx:=0;
  end else
   inc(countx);
 end;
end; 

Test için 250 Kb'lık bir dosya ile çalıştım.

Benim yazdığım kod 33 saniyede işlemi bitirdi. Sizin kod da işlem 33 saniye sürdü. Kendiniz de denemek isterseniz, programı buradan indirebilirsiniz.

@Z.D.'nın gönderdiği kod ise gerçekten çok çok hızlı. Aynı dosyada işlemi saniye sürmeden bitirdi. 16 mb'lık bir dosyayı da 12 saniyede işledi. Gerçekten çok çok teşekkür ederim @Z.D.

[Z.D.]

rica ederim. low-level de bazen işe yarıyor demekkili

[poshet303]

Örneği şimdi inceledim. Asıl sorun sizin işlemleri Memo üzerine yapmanız olmuş. Memo nun ekrana her eleman eklendiğinde çizilmesi o kadar pahalı ki Pos yada farklı bir işlemlele string karşılaştırması bunun yanında devede kulak kalıyor. Bnde sizin kodu TStringList ile işlem yapacak şekilde değiştirdim (işlem sonunda Memo ya yazılacak şekilde). Ve sonuçta 52 saniye süren işlem 4 saniyeye düştü.

Sayın @Z.D. nin ASM kodu elbetteki çok daha hızlı ama bunda yazma işleminin Memo değilde TStringList ile yapılmış olmasınıda payı var.

Ayrıca mesele bu işlemin ASM ile yapılmış olmasıda değiş sayın @Z.D. olduk optimal bir kod yazmış(anlaya bildiğim kadarıyla tabi. ASM ile ilgilenmeyeli çok zaman olmuş. Yinede "xor ebx,ebx" satırının ebx i 0 lamak için en optimal yol olduğunu hatırlıyorum). Yani ASM ile bu iş daha yavaş yapabilecek kodlar yazmakta mümkün olabilir.

Kısaca hızlı kod yazmanın yolu fazlaca teknik detay bilmekten geçiyor.

NOT: POS kullanılan kod acaba benim yazdığımdan hızlımı. Yada eşit hızlarda mı. Aslında POS da hemen hemen tüm temel string fonksiyonları gibi ASM ile yazıldığından bu mümkün. Ben bunu hiç hesaba katmadım tabi işin başında.