1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
############################################################################
#
# File: soundex.icn
#
# Subject: Procedures to produce Soundex code for name
#
# Author: Cheyenne Wills
#
# Date: July 14, 1989
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# This procedure produces a code for a name that tends to bring together
# variant spellings. See Donald E. Knuth, The Art of Computer Programming,
# Vol.3; Searching and Sorting, pp. 391-392.
#
############################################################################
procedure soundex(name)
local first, c, i
name := map(name,string(&lcase),string(&ucase)) # Convert to uppercase..
first := name[1]
# Retain the first letter of the name, and convert all
# occurrences of A,E,H,I,O,U,W,Y in other positions to "."
#
# Assign the following numbers to the remaining letters
# after the first:
#
# B,F,P,V => 1 L => 4
# C,G,J,K,Q,S,X,Z => 2 M,N => 5
# D,T => 3 R => 6
name := map(name,"ABCDEFGHIJKLMNOPQRSTUVWXYZ",
".123.12..22455.12623.1.2.2")
# If two or more letters with the same code were adjacent
# in the original name, omit all but the first
every c := !"123456" do
while i := find(c||c,name) do
name[i+:2] := c
name[1] := first
# Now delete our place holder ('.')
while i := upto('.',name) do name[i] := ""
return left(name,4,"0")
end
|
