88 lines
3 KiB
Text
88 lines
3 KiB
Text
lower = proc (c: char) returns (char)
|
|
if c >= 'A' & c <= 'Z' then
|
|
c := char$i2c(32 + char$c2i(c))
|
|
end
|
|
return(c)
|
|
end lower
|
|
|
|
soundex = proc (name: string) returns (string)
|
|
own coding: array[string] := array[string]$
|
|
[0:"aeiou","bfpv","cgjkqsxz","dt","l","mn","r"]
|
|
|
|
nums: array[int] := array[int]$[]
|
|
for i: int in int$from_to(1, string$size(name)) do
|
|
c: char := lower(name[i])
|
|
for n: int in array[string]$indexes(coding) do
|
|
if string$indexc(c, coding[n]) ~= 0 then
|
|
array[int]$addh(nums, n)
|
|
break
|
|
end
|
|
end
|
|
end
|
|
|
|
filtered: array[int] := array[int]$[]
|
|
for i: int in array[int]$indexes(nums) do
|
|
if nums[i]=0 cor i=1 then continue end
|
|
if nums[i]~=nums[i-1] then
|
|
array[int]$addh(filtered,nums[i])
|
|
end
|
|
end
|
|
|
|
code: string := string$c2s(name[1])
|
|
for i: int in array[int]$elements(filtered) do
|
|
if string$size(code) >= 4 then break end
|
|
code := code || int$unparse(i)
|
|
end
|
|
|
|
while string$size(code) < 4 do
|
|
code := code || "0"
|
|
end
|
|
return(code)
|
|
end soundex
|
|
|
|
start_up = proc ()
|
|
test = struct[name, code: string]
|
|
po: stream := stream$primary_output()
|
|
|
|
tests: array[test] := array[test]$[
|
|
test${name:"Ashcraft", code:"A261"},
|
|
test${name:"Burroughs", code:"B620"},
|
|
test${name:"Burrows", code:"B620"},
|
|
test${name:"Ekzampul", code:"E251"},
|
|
test${name:"Ellery", code:"E460"},
|
|
test${name:"Euler", code:"E460"},
|
|
test${name:"Example", code:"E251"},
|
|
test${name:"Gauss", code:"G200"},
|
|
test${name:"Ghosh", code:"G200"},
|
|
test${name:"Gutierrez", code:"G362"},
|
|
test${name:"Heilbronn", code:"H416"},
|
|
test${name:"Hilbert", code:"H416"},
|
|
test${name:"Jackson", code:"J250"},
|
|
test${name:"Kant", code:"K530"},
|
|
test${name:"Knuth", code:"K530"},
|
|
test${name:"Ladd", code:"L300"},
|
|
test${name:"Lee", code:"L000"},
|
|
test${name:"Lissajous", code:"L222"},
|
|
test${name:"Lloyd", code:"L300"},
|
|
test${name:"Lukasiewicz", code:"L222"},
|
|
test${name:"O'Hara", code:"O600"},
|
|
test${name:"Pfister", code:"P236"},
|
|
test${name:"Soundex", code:"S532"},
|
|
test${name:"Sownteks", code:"S532"},
|
|
test${name:"Tymczak", code:"T522"},
|
|
test${name:"VanDeusen", code:"V532"},
|
|
test${name:"Washington", code:"W252"},
|
|
test${name:"Wheaton", code:"W350"}
|
|
]
|
|
|
|
for t: test in array[test]$elements(tests) do
|
|
stream$putleft(po, t.name, 12)
|
|
stream$puts(po, " -> ")
|
|
c: string := soundex(t.name)
|
|
stream$puts(po, c)
|
|
if c ~= t.code
|
|
then stream$putl(po, " (Wrong!)")
|
|
else stream$putl(po, " (OK)")
|
|
end
|
|
end
|
|
end start_up
|