SQL ile aranan kelimelerin fazla oluşuna göre önce listeleme

Diğer veritabanları ve SQL komutlarıyla ilgli sorularınızı sorabilirsiniz. Delphi tarafındaki sorularınızı lütfen Programlama forumunda sorunuz.
Cevapla
Kullanıcı avatarı
ender_arslanturk
Kıdemli Üye
Mesajlar: 709
Kayıt: 18 Şub 2005 03:38
Konum: İstanbul

SQL ile aranan kelimelerin fazla oluşuna göre önce listeleme

Mesaj gönderen ender_arslanturk »

Şimdi şöyle bir SQL vodum var. Veritabanında kayıtlı bulunan verilerden arama metodlarına göre ilk 400 kaydı listelemektedir.

Kod: Tümünü seç

Select Top 400 * From Cevap 
Where ID>0 
and Contains(Cevap, '*Allah* or  *Allahın* or *Allah''ın* or *isimleri* or *nelerdir* or *Allah isimleri nelerdir* or *Allah''ın isimleri nelerdir*') 
Query.Open dediğimizde hem bu sorgunun hazırlanması hem de en çok bulunan kelimenin üstlerde listelenmesini nasıl sağlayabiliriz.

Yani kural şöyle olmalı kanımca;

1- İlk kayıtlarda öncelikle anlam olarak benzer olan kayıtların listelenmesi
2- Sonraki kayıtlarda her kelimeyi içeren kayıtların listelenmesi
3- Sonraki kayıtlarda ise kelimelerden içeriğinde ki fazlalık durumuna göre listeleme
4- Sonraki kayıtlarda ise en az bir kelime olanları listeleme

Bunu SQL ile yapabileceğimiz bir sorgu olabileceğini sanmıyorum. :)

Kayıt içinde ki bilgileri bir memoya aldığımızda, ve döngüyle satr satır kontrol yaptığımızda şöyle bir fonksiyon ile benzerlik karşılaştırılması yapılabilir.

Kod: Tümünü seç

Function CumleBenzerlikOrani(s1, s2: string): Integer;
var
  hit: Integer;
  p1, p2: Integer;
  l1, l2: Integer;
  pt: Integer;
  diff: Integer;
  hstr: string;

  test: array [1 .. 255] of Boolean;
begin
  if Length(s1) < Length(s2) then
  begin
    hstr := s2;
    s2 := s1;
    s1 := hstr;
  end;
  l1 := Length(s1);
  l2 := Length(s2);
  p1 := 1;
  p2 := 1;
  hit := 0;

  diff := Max(l1, l2) div 3 + ABS(l1 - l2);

  for pt := 1 to l1 do
    test[pt] := False;
  repeat
    if not test[p1] then
    begin
      if (s1[p1] = s2[p2]) and (ABS(p1 - p2) <= diff) then
      begin
        test[p1] := True;
        Inc(hit);
        Inc(p1);
        Inc(p2);
        if p1 > l1 then
          p1 := 1;
      end
      else
      begin
        test[p1] := False;
        Inc(p1);
        if p1 > l1 then
        begin
          while (p1 > 1) and not(test[p1]) do
            Dec(p1);
          Inc(p2)
        end;
      end;
    end
    else
    begin
      Inc(p1);
      if p1 > l1 then
      begin
        repeat
          Dec(p1);
        until (p1 = 1) or test[p1];
        Inc(p2);
      end;
    end;
  until p2 > Length(s2);
  Result := 100 * hit DIV l1;
end;

Kullanımı :

Kod: Tümünü seç

var
       Oran:Integer;
begin
       ....döngü
       Oran:=CumleBenzerlikOrani(Memo1.Items.Strings[I]  ,  Aranan   );
end;
Kısacası;

Hiç döngülere girmeden kullanıcı kullanım performansının verimli olması bakımından bunun SQL ile yapılabilmesi mümkün müdür ? Eğer değilse bu kodlamayı kullanıcının verimli kullanımın yüksek olabilecek şekilde en mantıklı nasıl modelleyebilirim ?

Şimdiden teşekkürler,
Kullanıcı avatarı
ender_arslanturk
Kıdemli Üye
Mesajlar: 709
Kayıt: 18 Şub 2005 03:38
Konum: İstanbul

Re: SQL ile aranan kelimelerin fazla oluşuna göre önce liste

Mesaj gönderen ender_arslanturk »

Selâmlar,

Bu gibi problem yaşayanlara çöözüm olması bakımından sonucu paylaşmak istedim..

Şimdi öncelikle veritabanımız da iki tane alandan bahsediyoruz.

Alanlar :
1- Soru <-- NMemo
2- Cevap <-- NMemo
3- BulunanKelimeSayisi Integer <-- Aranan kayıtların tek şartla listelenmesi için

NMemo alan SQL Serverda ki NText e denktir. Yani bilmeyenler için yazıyorum çok satırlı metinler kayıt edilen alandır. Normal Memo yani Text alandan farkı unicode desteğinin olmasıdır. Unicode Aynı kayda ister latin ister Arapça ister de japonca yazabilme imkanı tanır. ve bu gibi alanlar Contains ile özel aramaya tabi tutulur. En azından benim bildiğim öyle.:)

Çözüme gelince :

Aynı contains sorgusun da öncelik sonralık olmadığını düşündüğümden.

5 Farklı sorgu ile kontrolü zenginleştirdim ve işe yaradı. :)

1.

Kod: Tümünü seç

Update Tablom Set BulunanKelimeSayisi=Null Where (BulunanKelimeSayisi Is Not Null)
2.

Kod: Tümünü seç

Update Tablom Set BulunanKelimeSayisi=0 Where Contains(Soru, '*Allah isimleri nelerdir* or *Allah''ın isimleri nelerdir*') 
3.

Kod: Tümünü seç

Update Tablom Set BulunanKelimeSayisi=0 Where Contains(Cevap, '*Allah isimleri nelerdir* or *Allah''ın isimleri nelerdir*') 
4.

Kod: Tümünü seç

Update Tablom Set BulunanKelimeSayisi=0 Where Contains(Soru, '*Allah* or  *Allahın* or *Allah''ın* or *isimleri* or *nelerdir*') 
5.

Kod: Tümünü seç

Update Tablom Set BulunanKelimeSayisi=0 Where Contains(Cevap, '*Allah* or  *Allahın* or *Allah''ın* or *isimleri* or *nelerdir*') 

Yani önce soru başlıklarında cümle geçiyorsa onlar listeleniyor.
Sonra cevap içeriğinde cümle geçiyorsa soru başlıklarından sonra listeliyor.
Sonra yine soru başlıklarında ama bu sefer cümle değil kelime kelime arama gerçekleştiriyor.
Sonra da cevap içeriğin de yine cümle değil kelime kelime arama gerçekleştiriyor.

Her bir update sonra query.open ile bu kayıtlar çekiliyor. Yanlız openlar en sonra değil update sonrasında yapılmaktadır. Yani ilk 400 kaydı ilk soru başlıklarında çekmişsek diğer sorguları çalıştırmaya gerek yoktur.

İyi çalışmalar.
sr1111
Üye
Mesajlar: 220
Kayıt: 06 Mar 2008 01:59

Re: SQL ile aranan kelimelerin fazla oluşuna göre önce liste

Mesaj gönderen sr1111 »

bu algoritma işime cok yaradi fakat asagida bir text dosyasinda bulunan kelimeleri, memoda aratip %90 benzerse değiştir diyebilirim.

asıllı olan Cumhuriyet
olan Cumhuriyet Dönemi
olan İstiklâl Marşı'nın
Cumhuriyet Dönemi şairi,
Dönemi şairi, veteriner
şairi, veteriner hekim,
veteriner hekim, öğretmen
Kullanıcı avatarı
ender_arslanturk
Kıdemli Üye
Mesajlar: 709
Kayıt: 18 Şub 2005 03:38
Konum: İstanbul

Re: SQL ile aranan kelimelerin fazla oluşuna göre önce liste

Mesaj gönderen ender_arslanturk »

Kod: Tümünü seç

Function TForm1.KelimeEsitlikOrani(s1, s2: string): Integer;
var
  hit: Integer;
  p1, p2: Integer;
  l1, l2: Integer;
  pt: Integer;
  diff: Integer;
  hstr: string;

  test: array [1 .. 255] of Boolean;
begin
  if Length(s1) < Length(s2) then
  begin
    hstr := s2;
    s2 := s1;
    s1 := hstr;
  end;
  l1 := Length(s1);
  l2 := Length(s2);
  p1 := 1;
  p2 := 1;
  hit := 0;

  diff := Max(l1, l2) div 3 + ABS(l1 - l2);

  for pt := 1 to l1 do
    test[pt] := False;
  repeat
    if not test[p1] then
    begin
      if (s1[p1] = s2[p2]) and (ABS(p1 - p2) <= diff) then
      begin
        test[p1] := True;
        Inc(hit);
        Inc(p1);
        Inc(p2);
        if p1 > l1 then
          p1 := 1;
      end
      else
      begin
        test[p1] := False;
        Inc(p1);
        if p1 > l1 then
        begin
          while (p1 > 1) and not(test[p1]) do
            Dec(p1);
          Inc(p2)
        end;
      end;
    end
    else
    begin
      Inc(p1);
      if p1 > l1 then
      begin
        repeat
          Dec(p1);
        until (p1 = 1) or test[p1];
        Inc(p2);
      end;
    end;
  until p2 > Length(s2);
  Result := 100 * hit DIV l1;
end;



Kullanımı :

Kod: Tümünü seç

If KelimeEsitlikOrani('asıllı olan Cumhuriyet', Memo1.Text)>90 Then
begin
       Query.Append;
       Query......
       Query.Post;
end;
Cevapla