Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -1,42 +0,0 @@
|
|||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
|
||||
with Ada.Characters.Handling; use Ada.Characters.Handling;
|
||||
procedure Soundex is
|
||||
type UStrings is array(Natural range <>) of Unbounded_String;
|
||||
function "+"(S:String) return Unbounded_String renames To_Unbounded_String;
|
||||
|
||||
function toSoundex (instr : String) return String is
|
||||
str : String := To_Upper(instr);
|
||||
output : String := "0000";
|
||||
spos : Integer := str'First+1; opos : Positive := 2;
|
||||
map : array(0..255) of Character := (others => ' ');
|
||||
last : Integer := str'First;
|
||||
begin
|
||||
map(65..90) := " 123 12- 22455 12623 1-2 2";
|
||||
for i in str'Range loop str(i) := map(Character'Pos(str(i))); end loop;
|
||||
output(1) := str(str'First);
|
||||
while (opos <= 4 and spos <= str'Last) loop
|
||||
if str(spos) /= '-' and str(spos) /= ' ' then
|
||||
if (str(spos-1) = '-' and last = spos-2) and then
|
||||
(str(spos) = str(spos-2)) then null;
|
||||
elsif (str(spos) = output(opos-1) and last = spos-1) then last := spos;
|
||||
else output(opos) := str(spos); opos := opos + 1; last := spos;
|
||||
end if;
|
||||
end if;
|
||||
spos := spos + 1;
|
||||
end loop;
|
||||
output(1) := To_Upper(instr(instr'First));
|
||||
return output;
|
||||
end toSoundex;
|
||||
|
||||
cases : constant UStrings := (+"Soundex", +"Example", +"Sownteks",
|
||||
+"Ekzampul", +"Euler", +"Gauss", +"Hilbert", +"Knuth", +"Lloyd",
|
||||
+"Lukasiewicz", +"Ellery", +"Ghosh", +"Heilbronn", +"Kant",
|
||||
+"Ladd", +"Lissajous", +"Wheaton", +"Burroughs", +"Burrows",
|
||||
+"O'Hara", +"Washington", +"Lee", +"Gutierrez", +"Pfister",
|
||||
+"Jackson", +"Tymczak", +"VanDeusen", +"Ashcraft");
|
||||
begin
|
||||
for i in cases'Range loop
|
||||
Put_Line(To_String(cases(i))&" = "&toSoundex(To_String(cases(i))));
|
||||
end loop;
|
||||
end Soundex;
|
||||
|
|
@ -1,38 +1,37 @@
|
|||
code: #[
|
||||
"aeiouy": `W`
|
||||
"bfpv": `1`
|
||||
"cgjkqsxz": `2`
|
||||
"dt": `3`
|
||||
"l": `4`
|
||||
"mn": `5`
|
||||
"r": `6`
|
||||
"aeiouy": 'W'
|
||||
"bfpv": '1'
|
||||
"cgjkqsxz": '2'
|
||||
"dt": '3'
|
||||
"l": '4'
|
||||
"mn": '5'
|
||||
"r": '6'
|
||||
]
|
||||
|
||||
getCode: function [ch][
|
||||
loop keys code 'k [
|
||||
if contains? k lower to :string ch -> return code\[k]
|
||||
]
|
||||
return ` `
|
||||
return ' '
|
||||
]
|
||||
|
||||
soundex: function [str][
|
||||
result: new to :string first str
|
||||
result: to :string first str
|
||||
|
||||
prev: getCode first str
|
||||
loop.with:'i str 'c [
|
||||
curr: getCode c
|
||||
if curr <> ` ` [
|
||||
if and? curr <> `W`
|
||||
if curr <> ' ' [
|
||||
if and? curr <> 'W'
|
||||
curr <> prev -> 'result ++ curr
|
||||
prev: curr
|
||||
]
|
||||
]
|
||||
|
||||
if? 4 < size result ->
|
||||
result: new slice result 0 3
|
||||
else [
|
||||
switch 4 < size result -> result: slice result 0 3
|
||||
[
|
||||
do.times: 4-size result ->
|
||||
'result ++ `0`
|
||||
'result ++ '0'
|
||||
]
|
||||
return result
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1,149 +0,0 @@
|
|||
**** sndxtest *********************************************
|
||||
* Demonstrate the soundex encoding functions.
|
||||
***************************************************************
|
||||
Identification division.
|
||||
Program-id. sndxtest.
|
||||
|
||||
Data division.
|
||||
Working-storage section.
|
||||
01 sample-word-list.
|
||||
05 sample-words.
|
||||
10 filler pic x(15) value "soundex".
|
||||
10 filler pic x(15) value "example".
|
||||
10 filler pic x(15) value "sownteks".
|
||||
10 filler pic x(15) value "ekzampul".
|
||||
10 filler pic x(15) value "Euler".
|
||||
10 filler pic x(15) value "Gauss".
|
||||
10 filler pic x(15) value "Hilbert".
|
||||
10 filler pic x(15) value "Knuth".
|
||||
10 filler pic x(15) value "Lloyd".
|
||||
10 filler pic x(15) value "Lukasiewicz".
|
||||
10 filler pic x(15) value "Ellery".
|
||||
10 filler pic x(15) value "ghosh".
|
||||
10 filler pic x(15) value "Heilbronn".
|
||||
10 filler pic x(15) value "Kand".
|
||||
10 filler pic x(15) value "Ladd".
|
||||
10 filler pic x(15) value "lissajous".
|
||||
10 filler pic x(15) value "Wheaton".
|
||||
10 filler pic x(15) value "Burroughs".
|
||||
10 filler pic x(15) value "burrows".
|
||||
10 filler pic x(15) value "O'Hara".
|
||||
10 filler pic x(15) value "Washington".
|
||||
10 filler pic x(15) value "lee".
|
||||
10 filler pic x(15) value "Gutierrez".
|
||||
10 filler pic x(15) value "Phister".
|
||||
10 filler pic x(15) value "Jackson".
|
||||
10 filler pic x(15) value "tymczak".
|
||||
10 filler pic x(15) value "Vandeusen".
|
||||
10 filler pic x(15) value "Ashcraft".
|
||||
05 sample-word redefines sample-words
|
||||
pic x(15) occurs 28 times indexed by wrd-idx.
|
||||
01 wrd-code pic x999.
|
||||
|
||||
Procedure division.
|
||||
Perform varying wrd-idx from 1 by 1
|
||||
until wrd-idx greater than 28
|
||||
call "sndxenc" using
|
||||
by reference sample-word(wrd-idx)
|
||||
by reference wrd-code
|
||||
display wrd-code " " sample-word(wrd-idx)
|
||||
end-perform.
|
||||
Stop run.
|
||||
|
||||
End program sndxtest.
|
||||
|
||||
*** sndxenc ********************************************
|
||||
* Given a string return its soundex encoding.
|
||||
***************************************************************
|
||||
Identification division.
|
||||
Program-id. sndxenc.
|
||||
|
||||
Data division.
|
||||
Local-storage section.
|
||||
01 str-idx pic 99.
|
||||
01 let-code pic 9.
|
||||
01 prv-let-code pic 9.
|
||||
01 sdx-idx pic 9 value 1.
|
||||
|
||||
Linkage section.
|
||||
01 str-to-encode.
|
||||
05 str-first-let pic x.
|
||||
05 str-rest-let pic x occurs 14 times.
|
||||
01 sdx-code.
|
||||
05 sdx-first-let pic x.
|
||||
05 sdx-nums pic 9 occurs 3 times.
|
||||
|
||||
Procedure division using
|
||||
by reference str-to-encode
|
||||
by reference sdx-code.
|
||||
Perform encode-start thru encode-done.
|
||||
Goback.
|
||||
|
||||
Encode-start.
|
||||
Move zeros to sdx-code.
|
||||
Move function upper-case(str-first-let) to sdx-first-let.
|
||||
Call "sndxchar" using
|
||||
by reference str-first-let
|
||||
by reference let-code.
|
||||
Move let-code to prv-let-code.
|
||||
|
||||
Encode-string.
|
||||
Perform varying str-idx from 1 by 1
|
||||
until str-idx greater than 15
|
||||
or str-rest-let(str-idx) = space
|
||||
or sdx-idx greater than 3
|
||||
call "sndxchar" using
|
||||
by reference str-rest-let(str-idx)
|
||||
by reference let-code
|
||||
if let-code not equal 7 then
|
||||
if let-code not equal 0
|
||||
and let-code not equal prv-let-code
|
||||
move let-code to sdx-nums(sdx-idx)
|
||||
add 1 to sdx-idx
|
||||
end-if
|
||||
move let-code to prv-let-code
|
||||
end-if
|
||||
end-perform.
|
||||
|
||||
Encode-done.
|
||||
continue.
|
||||
End program sndxenc.
|
||||
|
||||
|
||||
*** sndxchar **********************************************
|
||||
* Given a character, return its soundex encoding.
|
||||
* Code 7 is for h or w, which an encoder should ignore when
|
||||
* either one separates double letters.
|
||||
***************************************************************
|
||||
Identification division.
|
||||
Program-id. sndxchar.
|
||||
|
||||
Data division.
|
||||
Local-storage section.
|
||||
01 lc-chr pic x.
|
||||
88 code1 value "b", "f", "p", "v".
|
||||
88 code2 value "c", "g", "j", "k", "q", "s", "x", "z".
|
||||
88 code3 value "d", "t".
|
||||
88 code4 value "l".
|
||||
88 code5 value "m", "n".
|
||||
88 code6 value "r".
|
||||
88 code7 value "h", "w".
|
||||
|
||||
Linkage section.
|
||||
01 char-to-encode pic x.
|
||||
01 char-sdx-code pic 9.
|
||||
|
||||
Procedure division using
|
||||
by reference char-to-encode
|
||||
by reference char-sdx-code.
|
||||
Move function lower-case(char-to-encode) to lc-chr.
|
||||
If code1 then move 1 to char-sdx-code
|
||||
else if code2 then move 2 to char-sdx-code
|
||||
else if code3 then move 3 to char-sdx-code
|
||||
else if code4 then move 4 to char-sdx-code
|
||||
else if code5 then move 5 to char-sdx-code
|
||||
else if code6 then move 6 to char-sdx-code
|
||||
else if code7 then move 7 to char-sdx-code
|
||||
else move 0 to char-sdx-code
|
||||
end-if.
|
||||
End program sndxchar.
|
||||
|
|
@ -1,108 +0,0 @@
|
|||
(defconst articulation-1 '("b" "f" "p" "v" "B" "F" "P" "V"))
|
||||
|
||||
(defconst articulation-2 '("c" "g" "j" "k" "q" "s" "x" "z" "C" "G" "J" "K" "Q" "S" "X" "Z"))
|
||||
|
||||
(defconst articulation-3 '("d" "t" "D" "T"))
|
||||
|
||||
(defconst articulation-4 '("l" "L"))
|
||||
|
||||
(defconst articulation-5 '("m" "n" "M" "N"))
|
||||
|
||||
(defconst articulation-6 '("r" "R"))
|
||||
|
||||
(defconst vowel '("a" "e" "i" "o" "u" "A" "E" "I" "O" "U"))
|
||||
|
||||
(defconst semi-vowels '("h" "w" "y" "H" "W" "Y"))
|
||||
|
||||
(defun drop-vowels (str)
|
||||
"Keep first letter, drop a, e, i, o, u."
|
||||
(let ((first-letter (substring str 0 1))
|
||||
(string-minus-first-letter (substring str 1)))
|
||||
(concat first-letter (replace-regexp-in-string "[aeiou]" "" string-minus-first-letter))))
|
||||
|
||||
(defun drop-semi-vowels (str)
|
||||
"Keep first letter, drop h, w, y."
|
||||
(let ((first-letter (substring str 0 1))
|
||||
(string-minus-first-letter (substring str 1)))
|
||||
(concat first-letter (replace-regexp-in-string "[hwy]" "" string-minus-first-letter))))
|
||||
|
||||
(defun drop-repeated-adjacent-consonants (str)
|
||||
"Drop repeated adjacent consonants with same Soundex number."
|
||||
(let ((current-letter)
|
||||
(next-letter)
|
||||
(current-soundex-number)
|
||||
(next-soundex-number)
|
||||
(modified-word str)
|
||||
(position-in-word 0))
|
||||
(condition-case nil
|
||||
(while (substring modified-word position-in-word (+ 2 position-in-word))
|
||||
(setq current-letter (substring modified-word position-in-word (1+ position-in-word)))
|
||||
(setq next-letter (substring modified-word (1+ position-in-word) (+ position-in-word 2)))
|
||||
(setq current-soundex-number (get-soundex-number current-letter))
|
||||
(setq next-soundex-number (get-soundex-number next-letter))
|
||||
(when (and
|
||||
(equal current-soundex-number next-soundex-number)
|
||||
(member current-soundex-number '("1" "2" "3" "4" "5")))
|
||||
(setq modified-word (replace-regexp-in-string (concat current-letter next-letter) current-letter modified-word)))
|
||||
(setq position-in-word (1+ position-in-word)))
|
||||
(error nil))
|
||||
modified-word))
|
||||
|
||||
(defun get-soundex-number (letter)
|
||||
"Get the Soundex number of LETTER.
|
||||
LETTER should be a string of just one letter.
|
||||
Soundex numbers are numbers 1-6.
|
||||
If the letter is a vowel or y, h, or w, there is
|
||||
no Soundex number, so get an 8 for a vowel or a 9
|
||||
for y, y, or w."
|
||||
(cond ((member letter articulation-1) "1")
|
||||
((member letter articulation-2) "2")
|
||||
((member letter articulation-3) "3")
|
||||
((member letter articulation-4) "4")
|
||||
((member letter articulation-5) "5")
|
||||
((member letter articulation-6) "6")
|
||||
((member letter vowel) "8")
|
||||
((member letter semi-vowel) "9")))
|
||||
|
||||
(defun soundex-all-but-first-letter (str)
|
||||
"Converts STR to Soundex except for first letter.
|
||||
For this function to work correctly, vowels and
|
||||
h, w, and y must have already been removed.
|
||||
Also, certain consonants must have already been
|
||||
removed per the Soundex processing rules."
|
||||
(let ((word-position 0)
|
||||
(current-letter)
|
||||
(converted-word "")
|
||||
(converted-character "")
|
||||
(word-length (length str)))
|
||||
(while (< word-position word-length)
|
||||
(setq current-letter (substring str word-position (1+ word-position)))
|
||||
(if (> word-position 0)
|
||||
(setq converted-character (get-soundex-number current-letter))
|
||||
(setq converted-character current-letter))
|
||||
(setq word-position (1+ word-position))
|
||||
(setq converted-word (concat converted-character converted-word)))
|
||||
(setq converted-word (reverse converted-word))
|
||||
(setq word-length (length converted-word))
|
||||
(cond ((= word-length 4)
|
||||
converted-word)
|
||||
((> word-length 4)
|
||||
(substring converted-word 0 4))
|
||||
((< word-length 4)
|
||||
(let* ((difference (- 4 word-length))
|
||||
(pad ""))
|
||||
(dotimes (_ difference)
|
||||
(setq pad (concat "0" pad)))
|
||||
(concat converted-word pad))))))
|
||||
|
||||
(defun soundex-word (str)
|
||||
"Code STR to Soundex.
|
||||
This function applies all the steps needed
|
||||
to code STR into the correct Soundex code."
|
||||
(let ((converted-word str))
|
||||
(setq converted-word (drop-repeated-adjacent-consonants converted-word))
|
||||
(setq converted-word (drop-semi-vowels converted-word))
|
||||
(setq converted-word (drop-repeated-adjacent-consonants converted-word))
|
||||
(setq converted-word (drop-vowels converted-word))
|
||||
(setq converted-word (soundex-all-but-first-letter converted-word))
|
||||
converted-word))
|
||||
|
|
@ -1,81 +0,0 @@
|
|||
function Get-Soundex
|
||||
{
|
||||
[CmdletBinding()]
|
||||
[OutputType([PSCustomObject])]
|
||||
Param
|
||||
(
|
||||
[Parameter(Mandatory=$true,
|
||||
ValueFromPipeline=$true,
|
||||
ValueFromPipelineByPropertyName=$true,
|
||||
Position=0)]
|
||||
[string[]]
|
||||
$InputObject
|
||||
)
|
||||
|
||||
Begin
|
||||
{
|
||||
$characterGroup = [PSCustomObject]@{
|
||||
1 = @('B','F','P','V')
|
||||
2 = @('C','G','J','K','Q','S','X','Z')
|
||||
3 = @('D','T')
|
||||
4 = @('L')
|
||||
5 = @('M','N')
|
||||
6 = @('R')
|
||||
}
|
||||
|
||||
function ConvertTo-SoundexDigit ([char]$Character)
|
||||
{
|
||||
switch ($Character)
|
||||
{
|
||||
{$_ -in $characterGroup.1} {return 1}
|
||||
{$_ -in $characterGroup.2} {return 2}
|
||||
{$_ -in $characterGroup.3} {return 3}
|
||||
{$_ -in $characterGroup.4} {return 4}
|
||||
{$_ -in $characterGroup.5} {return 5}
|
||||
{$_ -in $characterGroup.6} {return 6}
|
||||
Default {return 0}
|
||||
}
|
||||
}
|
||||
}
|
||||
Process
|
||||
{
|
||||
foreach ($String in $InputObject)
|
||||
{
|
||||
$originalString = $String
|
||||
$String = $String.ToUpper()
|
||||
$isHorWcharacter = $false
|
||||
$soundex = New-Object -TypeName System.Text.StringBuilder
|
||||
|
||||
$soundex.Append($String[0]) | Out-Null
|
||||
|
||||
for ($i = 1; $i -lt $String.Length; $i++)
|
||||
{
|
||||
$currentCharacterDigit = ConvertTo-SoundexDigit $String[$i]
|
||||
|
||||
if ($currentCharacterDigit -ne 0)
|
||||
{
|
||||
if ($i -eq (ConvertTo-SoundexDigit $String[$i-1]))
|
||||
{
|
||||
continue
|
||||
}
|
||||
|
||||
if (($i -gt 2) -and ($isHorWcharacter) -and ($currentCharacterDigit -eq (ConvertTo-SoundexDigit $String[$i-2])))
|
||||
{
|
||||
continue
|
||||
}
|
||||
|
||||
$soundex.Append($currentCharacterDigit) | Out-Null
|
||||
}
|
||||
|
||||
$isHorWcharacter = $String[$i] -in @('H','W')
|
||||
}
|
||||
|
||||
$soundexTail = ($soundex.ToString().Substring(1)).TrimStart((ConvertTo-SoundexDigit $String[0]).ToString())
|
||||
|
||||
[PSCustomObject]@{
|
||||
String = $originalString
|
||||
Soundex = ($soundex[0] + $soundexTail).PadRight(4,"0").Substring(0,4)
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -1,2 +0,0 @@
|
|||
"Ashcraft", "Ashcroft", "Gauss", "Ghosh", "Hilbert", "Heilbronn", "Lee", "Lloyd",
|
||||
"Moses", "Pfister", "Robert", "Rupert", "Rubin", "Tymczak", "Soundex", "Example" | Get-Soundex
|
||||
|
|
@ -1,18 +0,0 @@
|
|||
# script Soundex.ps1
|
||||
Param([string]$Phrase)
|
||||
Process {
|
||||
$src = $Phrase.ToUpper().Trim()
|
||||
$coded = $src[0..($src.Length - 1)] | %{
|
||||
if('BFPV'.Contains($_)) { '1' }
|
||||
elseif('CGJKQSXZ'.Contains($_)) { '2' }
|
||||
elseif('DT'.Contains($_)) { '3' }
|
||||
elseif('L'.Contains($_)) { '4' }
|
||||
elseif('MN'.Contains($_)) { '5' }
|
||||
elseif('R'.Contains($_)) { '6' }
|
||||
elseif('AEIOU'.Contains($_)) { 'v' }
|
||||
else { '.' }
|
||||
} | Where { $_ -ne '.'}
|
||||
$coded2 = 0..($coded.Length - 1) | %{ if ($_ -eq 0 -or $coded[$_] -ne $coded[$_ - 1]) { $coded[$_] } else { '' } }
|
||||
$coded2 = if ($coded[0] -eq 'v' -or $coded2[0] -ne $coded[0]) { $coded2 } else { $coded2[1..($coded2.Length - 1)] }
|
||||
$src[0] + ((-join $($coded2 | Where { $_ -ne 'v'})) + "000").Substring(0,3)
|
||||
}
|
||||
|
|
@ -1,15 +0,0 @@
|
|||
Function t([string]$value, [string]$expect) {
|
||||
$result = .\Soundex.ps1 -Phrase $value
|
||||
New-Object –TypeName PSObject –Prop @{ "Value"=$value; "Expect"=$expect; "Result"=$result; "Pass"=$($expect -eq $result) }
|
||||
}
|
||||
@(
|
||||
(t "Ashcraft" "A261"); (t "Ashcroft" "A261"); (t "Burroughs" "B620"); (t "Burrows" "B620");
|
||||
(t "Ekzampul" "E251"); (t "Example" "E251"); (t "Ellery" "E460"); (t "Euler" "E460");
|
||||
(t "Ghosh" "G200"); (t "Gauss" "G200"); (t "Gutierrez" "G362"); (t "Heilbronn" "H416");
|
||||
(t "Hilbert" "H416"); (t "Jackson" "J250"); (t "Kant" "K530"); (t "Knuth" "K530");
|
||||
(t "Lee" "L000"); (t "Lukasiewicz" "L222"); (t "Lissajous" "L222"); (t "Ladd" "L300");
|
||||
(t "Lloyd" "L300"); (t "Moses" "M220"); (t "O'Hara" "O600"); (t "Pfister" "P236");
|
||||
(t "Rubin" "R150"); (t "Robert" "R163"); (t "Rupert" "R163"); (t "Soundex" "S532");
|
||||
(t "Sownteks" "S532"); (t "Tymczak" "T522"); (t "VanDeusen" "V532"); (t "Washington" "W252");
|
||||
(t "Wheaton" "W350");
|
||||
) | Format-Table -Property Value,Expect,Result,Pass
|
||||
|
|
@ -1,43 +0,0 @@
|
|||
' Soundex
|
||||
tt=array( _
|
||||
"Ashcraft","Ashcroft","Gauss","Ghosh","Hilbert","Heilbronn","Lee","Lloyd", _
|
||||
"Moses","Pfister","Robert","Rupert","Rubin","Tymczak","Soundex","Example")
|
||||
tv=array( _
|
||||
"A261","A261","G200","G200","H416","H416","L000","L300", _
|
||||
"M220","P236","R163","R163","R150","T522","S532","E251")
|
||||
For i=lbound(tt) To ubound(tt)
|
||||
ts=soundex(tt(i))
|
||||
If ts<>tv(i) Then ok=" KO "& tv(i) Else ok=""
|
||||
Wscript.echo right(" "& i ,2) & " " & left( tt(i) &space(12),12) & " " & ts & ok
|
||||
Next 'i
|
||||
|
||||
Function getCode(c)
|
||||
Select Case c
|
||||
Case "B", "F", "P", "V"
|
||||
getCode = "1"
|
||||
Case "C", "G", "J", "K", "Q", "S", "X", "Z"
|
||||
getCode = "2"
|
||||
Case "D", "T"
|
||||
getCode = "3"
|
||||
Case "L"
|
||||
getCode = "4"
|
||||
Case "M", "N"
|
||||
getCode = "5"
|
||||
Case "R"
|
||||
getCode = "6"
|
||||
Case "W","H"
|
||||
getCode = "-"
|
||||
End Select
|
||||
End Function 'getCode
|
||||
|
||||
Function soundex(s)
|
||||
Dim code, previous, i
|
||||
code = UCase(Mid(s, 1, 1))
|
||||
previous = getCode(UCase(Mid(s, 1, 1)))
|
||||
For i = 2 To Len(s)
|
||||
current = getCode(UCase(Mid(s, i, 1)))
|
||||
If current <> "" And current <> "-" And current <> previous Then code = code & current
|
||||
If current <> "-" Then previous = current
|
||||
Next 'i
|
||||
soundex = Mid(code & "000", 1, 4)
|
||||
End Function 'soundex
|
||||
Loading…
Add table
Add a link
Reference in a new issue