22 lines
828 B
Plaintext
22 lines
828 B
Plaintext
procedure main(arglist) # computes soundex of each argument
|
|
every write(x := !arglist, " => ",soundex(x))
|
|
end
|
|
|
|
procedure soundex(name)
|
|
local dig,i,x
|
|
static con
|
|
initial { # construct mapping x[i] => i all else .
|
|
x := ["bfpv","cgjkqsxz","dt","l","mn","r"]
|
|
every ( dig := con := "") ||:= repl(i := 1 to *x,*x[i]) do con ||:= x[i]
|
|
con := map(map(&lcase,con,dig),&lcase,repl(".",*&lcase))
|
|
}
|
|
|
|
name := map(name) # lower case
|
|
name[1] := map(name[1],&lcase,&ucase) # upper case 1st
|
|
name := map(name,&lcase,con) # map cons
|
|
every x := !"123456" do
|
|
while name[find(x||x,name)+:2] := x # kill duplicates
|
|
while name[upto('.',name)] := "" # kill .
|
|
return left(name,4,"0")
|
|
end
|