Data commit

Task/Soundex/CLU/soundex.clu

@@ -0,0 +1,88 @@
+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