Newsgroup: it.comp.lang.visual-basic
Titolo: Sinonimi

Qualcuno sa dirmi un modo per calcolare la somiglianza tra due stringhe?
ES: Techno = Tekno
Grazie
Lorenzo

 wrote in message
news:8Q_26.200848$hk4.7...@news.infostrada.it...

Puoi essere piu' preciso?
Tony

...

Esistono degli algoritmi per fare questo.
Purtroppo non so essere piů preciso.
Quella che tu chiami "somiglianza" č comunque il "peso" di una parola.
Quello che mi ricordo di uno semplicissimo che avevo letto faceva piů o meno
cosě:
1) la prima lettera la converte in maiuscola.
2) fa la somma di tutti i codici ascii della parola facendo la proporzione
del risultato con &HFFFFFF.
3) mette nel primo byte il codice ascii della prima lettera (maiuscola) e
negli altri il risultato della somma.
Il risultato finale non č dei migliori poichč tutte le lettere finiscono
nella somma.
Ciao

 Tony
penso intenda quello che in clipper (posso nominarlo, tanto jimi non c'e')
era la funzione soundex(), che se non sbaglio restituiva john anche se uno
scriveva jon o simili.
in inglese coi nomi propri serve parecchio, es.
deborah - debra
barbara - barbra
mi sembrava di averla vista anche nell'api, ma mi devo essere sbagliato.

 barbara - barbra
Si, una cosa del genere.
Devo fare delle ricerche sun un DB e voglio che cercando ad es. "techno", mi
vengano trovate anche le occorrenze di "tecno"
Ciao
lorenzo

esisteva in clipper?? cacchio, il clipper era proprio bellino allora...
cmq credo che in ogni caso debba dargli tu dei parametri "minimi", e poi
puoi sfruttare "Like", o qualcosa del genere, ma devi cmq decidere tu dei
parametri per stabilire quando una parola č un sinonimo e quando non lo č...
mario

 Quello che gli serve e' l'algoritmo Soundex.
allora esiste, con questo nome. sai dove reperirlo ?

 ... ma non c'e' sul Sito Comune? Potrebbe essere utile.
il solito san roal :)
fra i sorgenti sul s.c. non l'ho visto. potrei sbagliarmi, ma la cosa piu'
simile e' il simplex ovver simplesso (che peraltro non ho la minima idea di
che sia).
grazie, pazienteremo... ( plurale di umilta' )
be' questa tua apparizione spero significhi che sei meno sotto pressione.
ciao, a.




       |
   +----------------------------------------------------------------------+
 */
/* $Id: soundex.c,v 1.13 2000/06/05 19:47:44 andi Exp $ */
#include "php.h"
#include <stdlib.h>
#include <errno.h>
#include <ctype.h>
#include "php_string.h"
/* Simple soundex algorithm as described by Knuth in TAOCP, vol 3 */
/* {{{ proto string soundex(string str)
   Calculate the soundex key of a string */
PHP_FUNCTION(soundex)
{
 char *somestring;
 int i, _small, len, code, last;
 pval *arg, **parg;
 char soundex[4 + 1];
 static char soundex_table[26] =
 {0,       /* A */
  '1',      /* B */
  '2',      /* C */
  '3',      /* D */
  0,       /* E */
  '1',      /* F */
  '2',      /* G */
  0,       /* H */
  0,       /* I */
  '2',      /* J */
  '2',      /* K */
  '4',      /* L */
  '5',      /* M */
  '5',      /* N */
  0,       /* O */
  '1',      /* P */
  '2',      /* Q */
  '6',      /* R */
  '2',      /* S */
  '3',      /* T */
  0,       /* U */
  '1',      /* V */
  0,       /* W */
  '2',      /* X */
  0,       /* Y */
  '2'};      /* Z */
 if (ZEND_NUM_ARGS() != 1 || zend_get_parameters_ex(1, &parg) == FAILURE) {
  WRONG_PARAM_COUNT;
 }
 convert_to_string_ex(parg);
 arg = *parg;
 if (arg->value.str.len==0) {
  RETURN_FALSE;
 }
 somestring = arg->value.str.val;
 len = arg->value.str.len;
 /* build soundex string */
 last = -1;
 for (i = 0, _small = 0; i < len && _small < 4; i++) {
  /* convert chars to upper case and strip non-letter chars */
  /* BUG: should also map here accented letters used in non */
  /* English words or names (also found in English text!): */
  /* esstsett, thorn, n-tilde, c-cedilla, s-caron, ... */
  code = toupper(somestring[i]);
  if (code >= 'A' && code <= 'Z') {
   if (_small == 0) {
    /* remember first valid char */
    soundex[_small++] = code;
    last = soundex_table[code - 'A'];
   }
   else {
    /* ignore sequences of consonants with same soundex */
    /* code in trail, and vowels unless they separate */
    /* consonant letters */
    code = soundex_table[code - 'A'];
    if (code != last) {
     if (code != 0) {
      soundex[_small++] = code;
     }
     last = code;
    }
   }
  }
 }
 /* pad with '0' and terminate with 0 ;-) */
 while (_small < 4) {
  soundex[_small++] = '0';
 }
 soundex[_small] = '\0';
 return_value->value.str.val = estrndup(soundex, _small);
 return_value->value.str.len = _small;
 return_value->type = IS_STRING;
}
/* }}} */
/*
 * Local variables:
 * tab-width: 4
 * c-basic-offset: 4
 * End:
 */

   /* esstsett, thorn, n-tilde, c-cedilla, s-caron, ... */
ciao, a.


'#### CUT FROM HERE ####
Option Explicit
Private Const SoundexLen = 4
' equivalenze
Private Const strEquivA As String = "ءہآأؤإ"
Private Const strEquivE As String = "بةتث"
Private Const strEquivC As String = "ا"
Private Const strEquivI As String = "جحخد"
Private Const strEquivN As String = "ر"
Private Const strEquivO As String = "زسشصض"
Private Const strEquivU As String = "ظعغـ"
Private Const strEquivY As String = "فY"
' pesi
Private Const strWeight As String = "AEHIOUYWBPFVCSKGJQXZDTLMNR"
Private Const valWeight As String = "00000000111122222222334556"
Private Function IsBaseAscii(ByVal iAsciiVal As Integer) As Boolean
    IsBaseAscii = (iAsciiVal >= 65 And iAsciiVal <= 122)
End Function
Private Function IsExtAscii(ByVal iAsciiVal As Integer) As Boolean
    IsExtAscii = (IsBaseAscii(iAsciiVal) Or (iAsciiVal >= 192 And
iAsciiVal <= 221))
End Function
Private Function set_weight(ByVal strAscii As String) As String
    Dim pos As Integer
    pos = InStr(strWeight, strAscii)
    If (pos = 0) Then
        set_weight = " "
    Else
        set_weight = Mid$(valWeight, pos, 1)
    End If
End Function
Private Function filtra_Ascii(ByVal charAscii As String) As String
    Dim iAscii As Integer
    If IsExtAscii(Asc(charAscii)) Then
        If InStr(strEquivA, charAscii) <> 0 Then
            charAscii = "A"
        ElseIf InStr(strEquivE, charAscii) <> 0 Then
            charAscii = "E"
        ElseIf charAscii = strEquivC Then
            charAscii = "C"
        ElseIf InStr(strEquivI, charAscii) <> 0 Then
            charAscii = "I"
        ElseIf charAscii = strEquivN Then
            charAscii = "N"
        ElseIf InStr(strEquivO, charAscii) <> 0 Then
            charAscii = "O"
        ElseIf InStr(strEquivU, charAscii) <> 0 Then
            charAscii = "U"
        ElseIf InStr(strEquivY, charAscii) <> 0 Then
            charAscii = "Y"
        End If
        filtra_Ascii = charAscii
    Else
        filtra_Ascii = ""
    End If
End Function
Public Function soundex(ByVal sWord As String) As String
    On Error GoTo error_handler
    Dim iLen As Integer
    Dim chrTmp As String
    Dim sPesi As String
    Dim wPesi As String
    Dim tmpWeight As String
    Dim pos As Integer
    Dim i As Integer
    iLen = Len(sWord)
    ' Se la stringa e' vuota, esce.
    If (iLen = 0) Then Exit Function
    ' Converte la stringa in maiuscolo.
    sWord = UCase$(sWord)
    ' Converte lettere accentate nelle equivalenti non accentate.
    For i = 1 To iLen
        chrTmp = Mid$(sWord, i, 1)
        If Not IsBaseAscii(Asc(chrTmp)) Then
            Mid$(sWord, i, 1) = filtra_Ascii(chrTmp)
        End If
    Next
    ' Scarta punteggiatura e caratteri non appartenenti all'alfabeto.
    i = 1
    While i <= iLen
        If Not IsExtAscii(Asc(Mid$(sWord, i, 1))) Then
            sWord = Left$(sWord, i - 1) & Mid$(sWord, i + 1)
            iLen = iLen - 1
        End If
        i = i + 1
    Wend
    ' Attribuzione dei pesi.
    sPesi = Space$(iLen)
    For i = 1 To iLen
        Mid$(sPesi, i, 1) = set_weight(Mid$(sWord, i, 1))
    Next
    ' Se il 2° carattere ha lo stesso peso del 1° carattere elimina il
secondo peso.
    If Mid$(sPesi, 2, 1) = Left$(sPesi, 1) Then Mid$(sPesi, 2, 1) = 0
    ' scarta peso 1a lettera
    sPesi = Mid$(sPesi, 2)
    iLen = iLen - 1
    ' Elimina i pesi duplicati o uguali a 0.
    i = 1
    wPesi = Space$(iLen)
    While i <= iLen
        tmpWeight = Mid$(sPesi, i, 1)
        If Val(tmpWeight) <> 0 And InStr(wPesi, tmpWeight) = 0 Then
            Mid$(wPesi, i, 1) = tmpWeight
        End If
        i = i + 1
    Wend
    ' Elimina blank dalla stringa pesi.
    wPesi = Trim$(wPesi)
    pos = InStr(wPesi, " ")
    Do Until pos = 0
        wPesi = Left$(wPesi, pos - 1) & Mid$(wPesi, pos + 1)
        pos = InStr(wPesi, " ")
    Loop
    ' inserisce in testa la 1a lettera
    sPesi = Left$(sWord, 1) & wPesi
    ' se il codice e' inferiore alla lunghezza massima, accoda 0;
    ' se il codice e' superiore alla lunghezza massima, tronca il
codice.
    iLen = Len(sPesi)
    If (iLen < SoundexLen) Then
        sPesi = sPesi & String$(SoundexLen - iLen, "0")
    ElseIf (iLen > SoundexLen) Then
        sPesi = Left$(sPesi, SoundexLen)
    End If
    ' Restituisce il codice soundex.
    soundex = sPesi
    Exit Function
error_handler:
    Err.Raise Err.Number, "soundex", Err.Description
End Function