Soundex: Difference between revisions
Soundex en FreeBASIC
(Add SenseTalk implementation) |
(Soundex en FreeBASIC) |
||
Line 1,792:
s" Burrows" soundex cr type \ B620 (W test) (any Welsh names?)
s" O'Hara" soundex cr type \ O600 (punctuation test)</lang>
=={{header|FreeBASIC}}==
{{trans|PureBasic}}
<lang freebasic>
Function getCode(c As String) As String
If Instr("BFPV", c) Then Return "1"
If Instr("CGJKQSXZ", c) Then Return "2"
If Instr("DT", c) Then Return "3"
If "L" = c Then Return "4"
If Instr("MN", c) Then Return "5"
If "R" = c Then Return "6"
If Instr("HW", c) Then Return "."
End Function
Function Soundex(palabra As String) As String
palabra = Ucase(palabra)
Dim As String code = Mid(palabra,1,1)
Dim As String previo = getCode(Left(palabra, 1)) ''""
Dim As String actual
For i As Byte = 2 To (Len(palabra) + 1)
actual = getCode(Mid(palabra, i, 1))
If actual = "." Then Continue For
If Len(actual) > 0 And actual <> previo Then code &= actual
previo = actual
If Len(code) = 4 Then Exit For
Next i
If Len(code) < 4 Then code &= String(4,"0")
Return Left(code,4)
End Function
Dim As String nombre
For i As Byte = 1 To 20
Read nombre
Print """"; nombre; """"; Tab(15); Soundex(nombre)
Next i
Data "Aschraft", "Ashcroft", "Euler", "Gauss", "Ghosh", "Hilbert", "Heilbronn", "Lee", "Lissajous", "Lloyd"
Data "Moses", "Pfister", "Robert", "Rupert", "Rubin", "Tymczak", "VanDeusen", "Wheaton", "Soundex", "Example"
Sleep
</lang>
=={{header|FutureBasic}}==
| |||