34 lines
1.2 KiB
Plaintext
34 lines
1.2 KiB
Plaintext
FUNCTION getcode$(c$)
|
|
IF POS("BFPV",c$)<>0 THEN LET getcode$ = "1"
|
|
IF POS("CGJKQSXZ",c$)<>0 THEN LET getcode$ = "2"
|
|
IF POS("DT",c$)<>0 THEN LET getcode$ = "3"
|
|
IF "L" = c$ THEN LET getcode$ = "4"
|
|
IF POS("MN",c$)<>0 THEN LET getcode$ = "5"
|
|
IF "R" = c$ THEN LET getcode$ = "6"
|
|
IF POS("HW",c$)<>0 THEN LET getcode$ = "."
|
|
END FUNCTION
|
|
|
|
FUNCTION soundex$(palabra$)
|
|
LET palabra$ = UCASE$(palabra$)
|
|
LET code$ = (palabra$)[1:1+1-1]
|
|
LET previo$ = getcode$((palabra$)[1:1])
|
|
FOR i = 2 TO (LEN(palabra$))
|
|
LET actual$ = getcode$((palabra$)[i:i+1-1])
|
|
IF actual$ <> "." THEN
|
|
IF LEN(actual$) > 0 AND actual$ <> previo$ THEN LET code$ = code$ & actual$
|
|
LET previo$ = actual$
|
|
IF LEN(code$) = 4 THEN EXIT FOR
|
|
END IF
|
|
NEXT i
|
|
IF LEN(code$) < 4 THEN LET code$ = code$ & repeat$("0"[1:1],4-LEN(code$))
|
|
LET soundex$ = (code$)[1:4]
|
|
END FUNCTION
|
|
|
|
FOR i = 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"
|
|
END
|