ورود

View Full Version : الگوریتم Soundex



Qermezkon
یک شنبه 08 اردیبهشت 1387, 07:11 صبح
سلام
من می خواهم الگوریتم SoundEx را با استفاده از کاراکترهای فارسی پیاده سازی کنم ,
مثال هایی که روی اینترنت پیدا کردن تماماً آوای حروف انگلیسی رو مشخص کرده بودند.
حالا از کجا می توانم آوای حروف فارسی (وزنی که به حروف فارسی داده می شود برای پیاده سازی الگوریتم Soundex) را پیدا کنم.
متشکرم

Qermezkon
سه شنبه 11 تیر 1387, 14:48 عصر
Public Shared Function Compute(ByVal Word As String) As String
Return Compute(Word, 4)
End Function

Public Shared Function Compute(ByVal Word As String, ByVal Length As Integer) As String
Dim Value As String = ""
Dim Size As Integer = Word.Length
If (Size > 1) Then
Word = Word.ToUpper()
Dim Chars() As Char = Word.ToCharArray()
Dim Buffer As New System.Text.StringBuilder
Buffer.Length = 0
Dim PrevCode As Integer = 0
Dim CurrCode As Integer = 0
Buffer.Append(Chars(0))
Dim i As Integer
Dim LoopLimit As Integer = Size - 1
For i = 1 To LoopLimit
Select Case Chars(i)
Case "ا", "آ", "ح", "خ", "ه", "ع", "غ", "ش", "و", "ي"
CurrCode = 0
Case "ف", "ب", "پ"
CurrCode = 1
Case "ج", "چ", "ژ", "ز", "س", "ص", "ظ", "ق", "ک", "گ"
CurrCode = 2
Case "ت", "ث", "ر", "د", "ذ", "ض", "ط"
CurrCode = 3
Case "ل"
CurrCode = 4
Case "م", "ن"
CurrCode = 5
Case "ر"
CurrCode = 6
End Select
If (CurrCode <> PrevCode) Then
If (CurrCode <> 0) Then
Buffer.Append(CurrCode)
End If
End If
If (Buffer.Length = Length) Then
Exit For
End If
Next
Size = Buffer.Length
If (Size < Length) Then
Buffer.Append("0", (Length - Size))
End If
Value = Buffer.ToString()
End If
Return Value
End Function