İki cümleyi karşılaştırıp, benzerliğini % delemek

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
Kullanıcı avatarı
Asri
Kıdemli Üye
Mesajlar: 767
Kayıt: 16 Eyl 2003 09:54
Konum: istanbul

İki cümleyi karşılaştırıp, benzerliğini % delemek

Mesaj gönderen Asri »

Burda yazmış olduğum kodlar ile iki cümleyi karşılatırıp benzerliğini yada bir cümlenin diğerini tam olarak kapsayıp kapsamadığını bulabileceksiniz.

"Ali okula gider. Dersine çalışır"
"Ali okula gider"

ikinci cümle birinci cümlede geçmektedir. Sonuc %100 olarak döner.
Karşılatırmada hangisinin önce yazıldığı önemli değildir.
Program her zaman kısa cümleyi uzun cümlenin içinde aramaktadır.

Aşağıdaki kodlar bir text dosyadan
kelime (tab) açıklaması
şeklinde bölümlenmiş bir text dosyadan. Kelime ve açıklaması ile sırayla okur. Database de kelime var ise açıklamlarını karşılaştırır. Açıklamalar aynı değil ise database e kaydeder.

Açıklamalara aynı ise işlem yapmadan bir sonraki kelimeyi okur ve bu şekilde benzersiz bütün kelime ve açıklamlarını import etmenizi sağlar.

"Bu çalışma iki cümlenin anlamları aynı mı sorsunun cevabı niteliğindedir.
mantık yardımlar ile geliştirilmiştir. Daha da geliştirebilecek arkadaşlar var ise kelime kökleri ayrımı gibi. Yardımlarını bekliyorum."



Kod: Tümünü seç

function kucult_tr(cumle:string): string;
var
a: string;
krk:char;
begin
  for it:=1 to length(cumle) do
  begin
   krk:=cumle[it];
   if not (krk in ['I','Ğ','Ü','Ş','İ','Ö','Ç']) then a:=a+(lowercase(krk));
   if (krk in ['I','Ğ','Ü','Ş','İ','Ö','Ç']) then
   begin
    if krk='I' then a:=a+'ı';
    if krk='Ğ' then a:=a+'ğ';
    if krk='Ü' then a:=a+'u';
    if krk='Ş' then a:=a+'s';
    if krk='İ' then a:=a+'i';
    if krk='Ö' then a:=a+'ö';
    if krk='Ç' then a:=a+'ç';
  end;
 end;
  result:=a;
end;

procedure tform1.kontrol_turks;
begin
  s1:=turksd;

  liste1.Clear;
  for it:=1 to 1000 do
  begin
      if s1='' then break;
      son1:=pos(chr(32),s1);gec:=copy(s1,1,son1-1);s1:=copy(s1,son1+1,length(s1));
      liste1.Add(gec);
  end;
  uzunluk1:=liste1.Count-1;
  uzunluk2:=liste2.Count-1;
end;

procedure tform1.kontrol_ings;
begin
  s1:=eskianlam;

  liste2.Clear;
  for it:=1 to 1000 do
  begin
      if s1='' then break;
      son1:=pos(chr(32),s1);gec:=copy(s1,1,son1-1);s1:=copy(s1,son1+1,length(s1));
      liste2.Add(gec);
  end;
  uzunluk1:=liste1.Count-1;
  uzunluk2:=liste2.Count-1;  
end;


function bakalimaynimi(s1, s2: string): Integer;
begin
  uzunluk1:=length(s1);
  uzunluk2:=length(s2);

  if uzunluk2 > uzunluk1 then
  begin
    gec:=s1;
    s1:=s2;
    s2:=gec;
  end;
  basari:=0;
  for i:=1 to length(s1) do
  begin
     if s1[i]=s2[i] then inc(basari) else break;
  end;
end;

procedure tform1.karsilastir;
begin
  uzunluk1:=liste1.Count-1;
  uzunluk2:=liste2.Count-1;
         turks:=turks;
       eskianlam:=eskianlam;
  if uzunluk2 < uzunluk1 then
  begin
    listet:=liste1;
    liste1:=liste2;
    liste2:=listet;
  end;
  kelimetoplami:=0;
  for ls1:=0 to liste1.Count-1 do
  begin
     kel1:=liste1.Strings[ls1];
     if kel1='' then continue;
     ebasari:=0;basari:=0;son1:=0;
     for ls2:=0 to liste2.Count-1 do
     begin
        kel2:=liste2.Strings[ls2];
        if kel2='' then continue;
        bakalimaynimi(kel1,kel2);
        if basari>ebasari then begin ebasari:=basari;ekel2:=kel2;end;
     end;
     ebasari:=100 * ebasari DIV length(kel1);
     if ebasari<>0 then begin
        kelimetoplami:=kelimetoplami+ebasari;
     end;
   end;


   basari:=(liste1.count)*100;
   basari:=(kelimetoplami*100) div basari;
//   if basari>=70 then label2.Caption:='Birbirinin aynı iki cumle'
//       else label2.Caption:='birbirinden farkli iki cumle';
end;

procedure tform1.hazirla_ekle;
var
tbeng:string;
label enson,son;
begin

 assignfile(f1,'kelimelistesi.txt');
 if fileexists(dosya) then  reset(f1)
                         else begin
                                showmessage(dosya+' dosyasi bulunmadi');
                                exit;
                              end;
 j:=0;
 repeat
   application.ProcessMessages;
   if iptal then break;
   readln(f1,s);
   s:=s+chr(9);
   son1:=pos(chr(9),s);ings:=copy(s,1,son1-1);s:=copy(s,son1+1,length(s));
   son1:=pos(chr(9),s);turks:=copy(s,1,son1-1);s:=copy(s,son1+1,length(s));
   turks:=kucult_tr(turks);
   turks:=trim(turks);
   turksd:=turks;

   ings:=ansilowercase(ings);
   ings:=trim(ings);
   ingsd:=ings;

   if (ingsd='') or (turksd='') then continue;
   varmi:=false;
   if engtb.locate('eng',ingsd,[]) then
   begin
     turksd:=turksd+' ';
     for ison:=1 to 100 do
     begin
       tbeng:=engtbeng.Value;
       turks:=turks;
       eskianlam:=eskianlam;

       if ingsd=tbeng then
       begin
         eskianlam:=engtbtur.Value+' ';
         kontrol_turks;
         kontrol_ings;
         karsilastir;
         if basari>50 then begin varmi:=true;break;end;
       end
       else
       begin
         varmi:=true;
         break;
       end;
       if engtb.Eof then begin break;end;
       engtb.next;
     end;
   end;
   if varmi then continue;

   inc(j);
   durum.Panels[0].Text:='Kayıt sayısı :'+inttostr(j);
   engtb.Append;
   engtbeng.Text:=ings;
   engtbtur.Value :=turks;
   ings:=turks;
   engtbturkisa.Text:=ings;
   engtb.UpdateRecord;
   engtb.ApplyRange;

 until eof(f1);

 closefile(f1);
 engtb.close;
 engtb.open;

 showmessage(inttostr(j)+' adet kelime eklendi.');

end;
Öğrenmek ve öğretmek, akıntıya karşı yüzmek gibidir ilerleyemediğiniz taktirde gerilersiniz.
Kullanıcı avatarı
Asri
Kıdemli Üye
Mesajlar: 767
Kayıt: 16 Eyl 2003 09:54
Konum: istanbul

Re: İki cümleyi karşılaştırıp, benzerliğini % delemek

Mesaj gönderen Asri »

merhaba...
viewtopic.php?p=41931#41931
makale ve yazinizi okumustum. buna benzer bir proje yapiyordum. gerekli procedureleri yapmama ragmen sizin projenizi calistiramadim. acaba izniniz olursa bana yollayabilirmisiniz.
Ne tür bir proje olduğunu bilmiyorum. Ancak, function bakalimaynimi(s1, s2: string): Integer; fonksiyonu iki cümleyi karşılaştıran bölümdür.

Tüm kodlar yerine sadece bu fonksiyonu kendi projenizde kullanarak sorunu çözebilirsiniz.

iyi çalışmalar.
Öğrenmek ve öğretmek, akıntıya karşı yüzmek gibidir ilerleyemediğiniz taktirde gerilersiniz.
sr1111
Üye
Mesajlar: 220
Kayıt: 06 Mar 2008 01:59

Re: İki cümleyi karşılaştırıp, benzerliğini % delemek

Mesaj gönderen sr1111 »

bakalim aynimi functionu duzgun calismiyor her seferinde %15 e kilitlenmis onu veriyor
Kullanıcı avatarı
Asri
Kıdemli Üye
Mesajlar: 767
Kayıt: 16 Eyl 2003 09:54
Konum: istanbul

Re: İki cümleyi karşılaştırıp, benzerliğini % delemek

Mesaj gönderen Asri »

sr1111 yazdı:bakalim aynimi functionu duzgun calismiyor her seferinde %15 e kilitlenmis onu veriyor
fonksiyonu nasıl kullandığınızı buraya yazabilir misiniz?
Öğrenmek ve öğretmek, akıntıya karşı yüzmek gibidir ilerleyemediğiniz taktirde gerilersiniz.
sr1111
Üye
Mesajlar: 220
Kayıt: 06 Mar 2008 01:59

Re: İki cümleyi karşılaştırıp, benzerliğini % delemek

Mesaj gönderen sr1111 »

ne yazarsam yazayim 15 i veriyor.
Memo1.Lines.Text := IntToStr(bakalimaynimi('cak', 'noncak'));
Kullanıcı avatarı
Asri
Kıdemli Üye
Mesajlar: 767
Kayıt: 16 Eyl 2003 09:54
Konum: istanbul

Re: İki cümleyi karşılaştırıp, benzerliğini % delemek

Mesaj gönderen Asri »

sr1111 yazdı:ne yazarsam yazayim 15 i veriyor.
Memo1.Lines.Text := IntToStr(bakalimaynimi('cak', 'noncak'));
İki kelimeyi karşılaştıran örnek dosya ektedir.

1. kelime Bağcılar
2. kelime Bağ

Benzerlik %37 olarak sonuç veriyor.

2. kelime "bağ" olsa idi sonuç sıfır çıkacaktı.

iyi çalışmalar.
Dosya ekleri
kelimekarsilastir.zip
Kelime karşılaştırma
(201.72 KiB) 144 kere indirildi
Öğrenmek ve öğretmek, akıntıya karşı yüzmek gibidir ilerleyemediğiniz taktirde gerilersiniz.
sr1111
Üye
Mesajlar: 220
Kayıt: 06 Mar 2008 01:59

Re: İki cümleyi karşılaştırıp, benzerliğini % delemek

Mesaj gönderen sr1111 »

forumdaki funcitonda bu satirlar eksik. ekleyebilirsiniz.
end;
result:=basari;
end;


anladigim kadari ile ilk harfine daha sonra sirasiyla diger harflere bakiyor.

ornegin sancak ancak kelimeleri % 0 veriyor. bu iki kelime normalde %80-90 larda olmasi lazim benzerliği
Kullanıcı avatarı
Asri
Kıdemli Üye
Mesajlar: 767
Kayıt: 16 Eyl 2003 09:54
Konum: istanbul

Re: İki cümleyi karşılaştırıp, benzerliğini % delemek

Mesaj gönderen Asri »

sr1111 yazdı:forumdaki funcitonda bu satirlar eksik. ekleyebilirsiniz.
end;
result:=basari;
end;

anladigim kadari ile ilk harfine daha sonra sirasiyla diger harflere bakiyor.

ornegin sancak ancak kelimeleri % 0 veriyor. bu iki kelime normalde %80-90 larda olmasi lazim benzerliği
Makalede "basari" değişkeni fonsiyon dışından sonucu almak için kullanıldığından eklemeye gerek yok.
Bu örnek de ise fonksiyon olarak sonuç dönüldüğü için ekledim.

Bu program, cümledeki kelimeleri karşılaştırmak için yapılan bir karşılaştırma kodu olduğu için ilk harften itibaren olması önemli bir nokta.
İlk harften itibaren olması doğru sonuç vermesi açısından önemlidir.
Bağ
Bağcı
Bağcılar
Öğrenmek ve öğretmek, akıntıya karşı yüzmek gibidir ilerleyemediğiniz taktirde gerilersiniz.
Cevapla